MetabaseThe simplest, fastest way to get business intelligence and analytics to everyone in your company 😋 | (this space intentionally left almost blank) |
namespaces
| |
Metabase Backend Developer DocumentationWelcome to Metabase! Here are links to useful resources. Project ManagementDev EnvironmentImportant Parts of the CodebaseImportant Libraries
| |
Put everything needed for REPL development within easy reach | (ns dev (:require [clojure.core.async :as a] [clojure.string :as str] [dev.debug-qp :as debug-qp] [dev.explain :as dev.explain] [dev.model-tracking :as model-tracking] [hashp.core :as hashp] [honey.sql :as sql] [java-time :as t] [malli.dev :as malli-dev] [metabase.api.common :as api] [metabase.config :as config] [metabase.core :as mbc] [metabase.db.connection :as mdb.connection] [metabase.db.env :as mdb.env] [metabase.db.setup :as mdb.setup] [metabase.driver :as driver] [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn] [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute] [metabase.models.database :refer [Database]] [metabase.query-processor :as qp] [metabase.query-processor.timezone :as qp.timezone] [metabase.server :as server] [metabase.server.handler :as handler] [metabase.sync :as sync] [metabase.test :as mt] [metabase.test.data.impl :as data.impl] [metabase.util :as u] [metabase.util.log :as log] [methodical.core :as methodical] [potemkin :as p] [toucan2.connection :as t2.connection] [toucan2.core :as t2] [toucan2.pipeline :as t2.pipeline])) |
(set! *warn-on-reflection* true) | |
(comment debug-qp/keep-me model-tracking/keep-me) | |
#_:clj-kondo/ignore (defn tap>-spy [x] (doto x tap>)) | |
(p/import-vars [debug-qp process-query-debug pprint-sql] [dev.explain explain-query] [model-tracking track! untrack! untrack-all! reset-changes! changes] [mt set-ns-log-level!]) | |
Was Metabase already initialized? Used in | (def initialized? (atom nil)) |
Trigger general initialization, but only once. | (defn init!
[]
(when-not @initialized?
(mbc/init!)
(reset! initialized? true))) |
Returns a UTC timestamp in format | (defn migration-timestamp [] (t/format (t/formatter "yyyy-MM-dd'T'HH:mm:ss") (t/zoned-date-time (t/zone-id "UTC")))) |
Finds in-memory Databases for which the underlying in-mem h2 db no longer exists. | (defn deleted-inmem-databases
[]
(let [h2-dbs (t2/select :model/Database :engine :h2)
in-memory? (fn [db] (some-> db :details :db (str/starts-with? "mem:")))
can-connect? (fn [db]
#_:clj-kondo/ignore
(binding [metabase.driver.h2/*allow-testing-h2-connections* true]
(try
(driver/can-connect? :h2 (:details db))
(catch org.h2.jdbc.JdbcSQLNonTransientConnectionException _
false)
(catch Exception e
(log/error e "Error checking in-memory database for deletion")
;; we don't want to delete these, so just pretend we could connect
true))))]
(remove can-connect? (filter in-memory? h2-dbs)))) |
Delete any in-memory Databases to which we can't connect (in order to trigger cleanup of their related tasks, which will otherwise spam logs). | (defn prune-deleted-inmem-databases!
[]
(when-let [outdated-ids (seq (map :id (deleted-inmem-databases)))]
(t2/delete! :model/Database :id [:in outdated-ids]))) |
Start Metabase | (defn start!
[]
(server/start-web-server! #'handler/app)
(init!)
(when config/is-dev?
(prune-deleted-inmem-databases!)
(with-out-str (malli-dev/start!)))) |
Stop Metabase | (defn stop! [] (malli-dev/stop!) (server/stop-web-server!)) |
Restart Metabase | (defn restart! [] (stop!) (start!)) |
Unmap all interned vars in a namespace. Reset the namespace to a blank slate! Perfect for when you rename everything and want to make sure you didn't miss a reference or when you redefine a multimethod. (ns-unmap-all ns) | (defn ns-unmap-all
([]
(ns-unmap-all *ns*))
([a-namespace]
(doseq [[symb] (ns-interns a-namespace)]
(ns-unmap a-namespace symb))
(doseq [[symb varr] (ns-refers a-namespace)
:when (not= (the-ns (:ns (meta varr)))
(the-ns 'clojure.core))]
(ns-unmap a-namespace symb)))) |
Remove all aliases for other namespaces from the current namespace. (ns-unalias-all ns) | (defn ns-unalias-all
([]
(ns-unalias-all *ns*))
([a-namespace]
(doseq [[symb] (ns-aliases a-namespace)]
(ns-unalias a-namespace symb)))) |
Rather than requiring all models in the ns declaration, make it easy to require the ones you need for your current session | (defmacro require-model [model-sym] `(require [(symbol (str "metabase.models." (quote ~model-sym))) :as (quote ~model-sym)])) |
Execute the body with the given permissions. | (defmacro with-permissions
[permissions & body]
`(binding [api/*current-user-permissions-set* (delay ~permissions)]
~@body)) |
Execute a SQL query against a JDBC database. Useful for testing SQL syntax locally. (query-jdbc-db :oracle SELECT to_date('1970-01-01', 'YYYY-MM-DD') FROM dual")
You can query against a dataset other than the default test data DB by passing in a (dev/query-jdbc-db [:sqlserver 'test-data-with-time] ["SELECT * FROM dbo.users WHERE dbo.users.lastlogintime > ?" (java-time/offset-time "16:00Z")]) | (defn query-jdbc-db
{:arglists '([driver sql] [[driver dataset] sql]
[driver honeysql-form] [[driver dataset] honeysql-form]
[driver [sql & params]] [[driver dataset] [sql & params]])}
[driver-or-driver+dataset sql-args]
(let [[driver dataset] (u/one-or-many driver-or-driver+dataset)
[sql & params] (if (map? sql-args)
(sql/format sql-args)
(u/one-or-many sql-args))
canceled-chan (a/promise-chan)]
(try
(driver/with-driver driver
(letfn [(thunk []
(let [db (mt/db)]
(sql-jdbc.execute/do-with-connection-with-options
driver
db
{:session-timezone (qp.timezone/report-timezone-id-if-supported driver db)}
(fn [conn]
(with-open [stmt (sql-jdbc.execute/prepared-statement driver conn sql params)
rs (sql-jdbc.execute/execute-prepared-statement! driver stmt)]
(let [rsmeta (.getMetaData rs)]
{:cols (sql-jdbc.execute/column-metadata driver rsmeta)
:rows (reduce conj [] (sql-jdbc.execute/reducible-rows driver rs rsmeta canceled-chan))}))))))]
(if dataset
(data.impl/do-with-dataset (data.impl/resolve-dataset-definition *ns* dataset) thunk)
(thunk))))
(catch InterruptedException e
(a/>!! canceled-chan :cancel)
(throw e))))) |
Run migrations for the Metabase application database. Possible directions are | (defn migrate!
([]
(migrate! :up))
([direction & [version]]
(mdb.setup/migrate! (mdb.connection/db-type) (mdb.connection/data-source)
direction version))) |
(methodical/defmethod t2.connection/do-with-connection :model/Database
"Support running arbitrary queries against data warehouse DBs for easy REPL debugging. Only works for SQL+JDBC drivers
right now!
;; use Honey SQL
(t2/query (t2/select-one Database :engine :postgres, :name \"test-data\")
{:select [:*], :from [:venues]})
;; use it with `select`
(t2/select :conn (t2/select-one Database :engine :postgres, :name \"test-data\")
\"venues\")
;; use it with raw SQL
(t2/query (t2/select-one Database :engine :postgres, :name \"test-data\")
\"SELECT * FROM venues;\")"
[database f]
(t2.connection/do-with-connection (sql-jdbc.conn/db->pooled-connection-spec database) f)) | |
(methodical/defmethod t2.pipeline/build [#_query-type :default
#_model :default
#_resolved-query :mbql]
[_query-type _model _parsed-args resolved-query]
resolved-query) | |
(methodical/defmethod t2.pipeline/compile [#_query-type :default
#_model :default
#_built-query :mbql]
"Run arbitrary MBQL queries. Only works for SQL right now!
;; Run a query against a Data warehouse DB
(t2/query (t2/select-one Database :name \"test-data\")
(mt/mbql-query venues))
;; Run MBQL queries against the application database
(t2/query (dev/with-app-db (mt/mbql-query core_user {:aggregation [[:min [:get-year $date_joined]]]})))
=>
[{:min 2023}]"
[_query-type _model built-query]
;; make sure we use the application database when compiling the query and not something goofy like a connection for a
;; Data warehouse DB, if we're using this in combination with a Database as connectable
(let [{:keys [query params]} (binding [t2.connection/*current-connectable* nil]
(qp/compile built-query))]
(into [query] params))) | |
Add the application database as a Database. Currently only works if your app DB uses broken-out details! | (defn app-db-as-data-warehouse
[]
(binding [t2.connection/*current-connectable* nil]
(or (t2/select-one Database :name "Application Database")
#_:clj-kondo/ignore
(let [details (#'metabase.db.env/broken-out-details
(mdb.connection/db-type)
@#'metabase.db.env/env)
app-db (first (t2/insert-returning-instances! Database
{:name "Application Database"
:engine (mdb.connection/db-type)
:details details}))]
(sync/sync-database! app-db)
app-db)))) |
Use the app DB as a | (defmacro with-app-db
[& body]
`(let [db# (app-db-as-data-warehouse)]
(mt/with-driver (:engine db#)
(mt/with-db db#
~@body)))) |
p, but to use in pipelines like `(-> 1 inc dev/p inc)`.See https://github.com/weavejester/hashp | (defmacro p [form] (hashp/p* form)) |
TODO -- I think this should be moved to something like [[metabase.test.util.debug-qp]] | (ns dev.debug-qp (:require [clojure.pprint :as pprint] [clojure.string :as str] [clojure.walk :as walk] [lambdaisland.deep-diff2 :as ddiff] [medley.core :as m] [metabase.db.query :as mdb.query] [metabase.mbql.normalize :as mbql.normalize] [metabase.mbql.schema :as mbql.s] [metabase.mbql.util :as mbql.u] [metabase.models.field :refer [Field]] [metabase.models.table :refer [Table]] [metabase.query-processor :as qp] [metabase.query-processor.reducible :as qp.reducible] [metabase.util :as u] [toucan2.core :as t2])) |
[[->sorted-mbql-query-map]] | |
(def ^:private mbql-clause->sort-order
(into {}
(map-indexed (fn [i k]
[k i]))
[;; top-level keys
:database
:type
:query
:native
;; inner-query and join keys
:source-table
:source-query
:source-metadata
:alias
:joins
:expressions
:breakout
:aggregation
:condition
:fields
:strategy
:filter
:order-by
:page
:limit])) | |
(defn- sorted-mbql-query-map []
;; stuff in [[mbql-clause->sort-order]] should always get sorted according to that order. Everything else should go at
;; the end, with non-namespaced stuff first and namespaced stuff last; otherwise sort alphabetically
(sorted-map-by (fn [x y]
(let [order (fn [k]
(or (mbql-clause->sort-order k)
(when (and (keyword? k) (namespace k))
Integer/MAX_VALUE)
(dec Integer/MAX_VALUE)))
x-order (order x)
y-order (order y)]
(if (= x-order y-order)
(compare (str x) (str y))
(compare x-order y-order)))))) | |
Whether to shorten something like | (def ^:dynamic *shorten-namespaced-keywords?* true) |
(defn- alias-for-namespace-in-*ns* [ns-symb]
(let [a-namespace (find-ns (symbol ns-symb))]
(some
(fn [[ns-alias aliased-namespace]]
(when (= aliased-namespace a-namespace)
ns-alias))
(ns-aliases *ns*)))) | |
Convert MBQL | (defn ->sorted-mbql-query-map
[query]
(walk/postwalk
(fn [form]
(cond
(map? form)
(into (sorted-mbql-query-map) form)
(and *shorten-namespaced-keywords?*
(keyword? form)
(namespace form))
(if-let [ns-alias (alias-for-namespace-in-*ns* (symbol (namespace form)))]
(symbol (format "::%s/%s" ns-alias (name form)))
form)
:else
form))
query)) |
[[add-names]] | |
(defn- field-and-table-name [field-id]
(let [{field-name :name, table-id :table_id} (t2/select-one [Field :name :table_id] :id field-id)]
[(t2/select-one-fn :name Table :id table-id) field-name])) | |
(defn- add-table-id-name [table-id]
(list 'do
(symbol (format "#_%s" (pr-str (t2/select-one-fn :name Table :id table-id))))
table-id)) | |
Walk a MBQL snippet | (defn add-names
[x]
(-> (walk/postwalk
(fn add-names* [form]
(letfn [(add-name-to-field-id [id]
(when id
(let [[field-name table-name] (field-and-table-name id)]
(symbol (format "#_\"%s.%s\"" field-name table-name)))))
(field-id->name-form [field-id]
(list 'do (add-name-to-field-id field-id) field-id))]
(mbql.u/replace form
[:field (id :guard pos-int?) opts]
[:field id (add-name-to-field-id id) (cond-> opts
(pos-int? (:source-field opts))
(update :source-field field-id->name-form))]
(m :guard (every-pred map? (comp pos-int? :source-table)))
(add-names* (update m :source-table add-table-id-name))
(m :guard (every-pred map? (comp pos-int? :metabase.query-processor.util.add-alias-info/source-table)))
(add-names* (update m :metabase.query-processor.util.add-alias-info/source-table add-table-id-name))
(m :guard (every-pred map? (comp pos-int? :fk-field-id)))
(-> m
(update :fk-field-id field-id->name-form)
add-names*)
;; don't recursively replace the `do` lists above, other we'll get vectors.
(_ :guard (every-pred list? #(= (first %) 'do)))
&match)))
x)
->sorted-mbql-query-map)) |
[[process-query-debug]] | |
see docstring for [[process-query-debug]] for descriptions of what these do. | |
(def ^:private ^:dynamic *print-full?* true) (def ^:private ^:dynamic *print-metadata?* false) (def ^:private ^:dynamic *print-names?* true) (def ^:private ^:dynamic *validate-query?* false) | |
Replace field metadata in | (defn- remove-metadata
[x]
(walk/prewalk
(fn [form]
(if (map? form)
(reduce
(fn [m k]
(m/update-existing m k (constantly '...)))
form
[:cols :results_metadata :source-metadata])
form))
x)) |
(defn- format-output [x]
(cond-> x
(not *print-metadata?*) remove-metadata
*print-names?* add-names)) | |
(defn- print-diff [before after]
(assert (not= before after))
(ddiff/pretty-print (ddiff/diff before after)
;; the default printer is very (too?) colorful.
;; this is one that strips color except for the diffs:
(ddiff/printer {:color-scheme
{:lambdaisland.deep-diff2.printer-impl/deletion [:red]
:lambdaisland.deep-diff2.printer-impl/insertion [:green]
:lambdaisland.deep-diff2.printer-impl/other [:white]
:delimiter nil
:tag nil
:nil nil
:boolean nil
:number nil
:string nil
:character nil
:keyword nil
:symbol nil
:function-symbol nil
:class-delimiter nil
:class-name nil}}))
(println)) | |
(defn- print-transform-result [before after]
(when *print-full?*
(println (u/pprint-to-str 'cyan (format-output after))))
(print-diff before after)) | |
(defn- print-error [location middleware-var e]
(println (format "Error %s in %s:\n%s"
location
middleware-var
(u/pprint-to-str 'red (Throwable->map e))))) | |
Writes the debugger event to the standard output. Uses colors and deep diffing to show changes made by middlewares. This is the default printer of | (defmulti print-formatted-event first) |
(defmethod print-formatted-event ::transformed-query [[_ middleware-var before after]] (println (format "[pre] %s transformed query:" middleware-var)) (print-transform-result before after)) | |
(defmethod print-formatted-event ::pre-process-query-error [[_ middleware-var e]] (print-error "pre-processing query" middleware-var e)) | |
(defmethod print-formatted-event ::transformed-metadata [[_ middleware-var before after]] (println (format "[post] %s transformed metadata:" middleware-var)) (print-transform-result before after)) | |
(defmethod print-formatted-event ::post-process-metadata-error [[_ middleware-var e]] (print-error "post-processing result metadata" middleware-var e)) | |
(defmethod print-formatted-event ::post-process-result-error [[_ middleware-var e]] (print-error "post-processing result" middleware-var e)) | |
(defmethod print-formatted-event ::transformed-result [[_ middleware-var before after]] (println (format "[post] %s transformed result:" middleware-var)) (print-transform-result before after)) | |
(defmethod print-formatted-event ::error-reduce-row [[_ middleware-var e]] (print-error "reducing row" middleware-var e)) | |
(defmethod print-formatted-event ::transformed-row [[_ middleware-var before after]] (println (format "[post] %s transformed row" middleware-var)) (print-transform-result before after)) | |
(def ^:private ^:dynamic *printer* print-formatted-event) | |
(defn- debug-query-changes [middleware-var middleware]
(fn [next-middleware]
(fn [query-before rff context]
(try
((middleware
(fn [query-after rff context]
(when-not (= query-before query-after)
(*printer* [::transformed-query middleware-var query-before query-after]))
(when *validate-query?*
(try
(mbql.s/validate-query query-after)
(catch Throwable e
(when (::our-error? (ex-data e))
(throw e))
(throw (ex-info (format "%s middleware produced invalid query" middleware-var)
{::our-error? true
:middleware middleware-var
:before query-before
:query query-after}
e)))))
(next-middleware query-after rff context)))
query-before rff context)
(catch Throwable e
(when (::our-error? (ex-data e))
(throw e))
(*printer* [::pre-process-query-error middleware-var e])
(throw (ex-info "Error pre-processing query"
{::our-error? true
:middleware middleware-var
:query query-before}
e))))))) | |
(defn- debug-rffs [middleware-var middleware before-rff-xform after-rff-xform]
(fn [next-middleware]
(fn [query rff-after context]
((middleware
(fn [query rff-before context]
(next-middleware query (before-rff-xform rff-before) context)))
query (after-rff-xform rff-after) context)))) | |
(defn- debug-metadata-changes [middleware-var middleware]
(let [before (atom nil)]
(debug-rffs
middleware-var
middleware
(fn before-rff-xform [rff]
(fn [metadata-before]
(reset! before metadata-before)
(try
(rff metadata-before)
(catch Throwable e
(when (::our-error? (ex-data e))
(throw e))
(*printer* [::post-process-metadata-error middleware-var e])
(throw (ex-info "Error post-processing result metadata"
{::our-error? true
:middleware middleware-var
:metadata metadata-before}
e))))))
(fn after-rff-xform [rff]
(fn [metadata-after]
(when-not (= @before metadata-after)
(*printer* [::transformed-metadata middleware-var @before metadata-after]))
(rff metadata-after)))))) | |
(defn- debug-rfs [middleware-var middleware before-xform after-xform]
(debug-rffs
middleware-var
middleware
(fn before-rff-xform [rff]
(fn [metadata]
(let [rf (rff metadata)]
(before-xform rf))))
(fn after-rff-xform [rff]
(fn [metadata]
(let [rf (rff metadata)]
(after-xform rf)))))) | |
(defn- debug-result-changes [middleware-var middleware]
(let [before (atom nil)]
(debug-rfs
middleware-var
middleware
(fn before-xform [rf]
(fn
([] (rf))
([result]
(reset! before result)
(try
(rf result)
(catch Throwable e
(when (::our-error? (ex-data e))
(throw e))
(*printer* [::post-process-result-error middleware-var e])
(throw (ex-info "Error post-processing result"
{::our-error? true
:middleware middleware-var
:result result}
e)))))
([result row] (rf result row))))
(fn after-xform [rf]
(fn
([] (rf))
([result]
(when-not (= @before result)
(*printer* [::transformed-result middleware-var @before result]))
(rf result))
([result row] (rf result row))))))) | |
(defn- debug-row-changes [middleware-var middleware]
(let [before (atom nil)]
(debug-rfs
middleware-var
middleware
(fn before-xform [rf]
(fn
([] (rf))
([result]
(rf result))
([result row]
(reset! before row)
(try
(rf result row)
(catch Throwable e
(when (::our-error? (ex-data e))
(throw e))
(*printer* [::error-reduce-row middleware-var e])
(throw (ex-info "Error reducing row"
{::our-error? true
:middleware middleware-var
:result result
:row row}
e)))))))
(fn after-xform [rf]
(fn
([] (rf))
([result]
(rf result))
([result row]
(when-not (= @before row)
(*printer* [::transformed-row @before row]))
(rf result row))))))) | |
The default set of middleware applied to queries ran via [[process-query-debug]]. Analogous to [[qp/default-middleware]]. | (defn- default-debug-middleware
[]
(into
[]
(comp cat (keep identity))
[@#'qp/execution-middleware
@#'qp/compile-middleware
@#'qp/post-processing-middleware
;; Normally, pre-processing middleware are applied to the query left-to-right, but in debug mode we convert each
;; one into a transducing middleware and compose them, which causes them to be applied right-to-left. So we need
;; to reverse the order here.
(reverse @#'qp/pre-processing-middleware)
@#'qp/around-middleware])) |
Takes a pre-processing middleware function, and converts it to a transducing middleware with the signature: (f (f query rff context)) -> (f query rff context) | (defn- alter-pre-processing-middleware
[middleware]
(fn [qp-or-query]
(if (map? qp-or-query)
;; If we're passed a map, this means the middleware var is still being called on a query directly. This happens
;; if pre-processing middleware calls other pre-processing middleware, such as [[upgrade-field-literals]] which
;; calls [[resolve-fields]]. Fallback to the original middleware function in this case.
(middleware qp-or-query)
(fn [query rff context]
(qp-or-query
(middleware query)
rff
context))))) |
Takes a pre-processing middleware function, and converts it to a transducing middleware with the signature: (f (f query rff context)) -> (f query rff context) | (defn- alter-post-processing-middleware
[middleware]
(fn [qp]
(fn [query rff context]
(qp query (middleware query rff) context)))) |
Implementation function for [[with-altered-middleware]]. Temporarily alters the root bindings for pre- and post-processing middleware vars, changing them to transducing middleware which can individually be wrapped with debug middleware in [[process-query-debug]]. | (defn- with-altered-middleware-fn
[f]
(let [pre-processing-middleware-vars @#'qp/pre-processing-middleware
post-processing-middleware-vars @#'qp/post-processing-middleware
pre-processing-original-fns (zipmap pre-processing-middleware-vars
(map deref pre-processing-middleware-vars))
post-processing-original-fns (zipmap post-processing-middleware-vars
(map deref post-processing-middleware-vars))]
(try
(mapv #(alter-var-root % alter-pre-processing-middleware) pre-processing-middleware-vars)
(mapv #(alter-var-root % alter-post-processing-middleware) post-processing-middleware-vars)
(f)
(finally
(mapv (fn [[middleware-var middleware-fn]]
(alter-var-root middleware-var (constantly middleware-fn)))
(merge pre-processing-original-fns post-processing-original-fns)))))) |
Temporarily redefines pre-processing and post-processing middleware vars to equivalent transducing middlewares, so that [[process-query-debug]] can print the transformations for each middleware individually. | (defmacro ^:private with-altered-middleware [& body] `(with-altered-middleware-fn (fn [] ~@body))) |
Process a query using a special QP that wraps all of the normal QP middleware and prints any transformations done during pre or post-processing. Options:
| (defn process-query-debug
[query & {:keys [print-full? print-metadata? print-names? validate-query? printer context]
:or {print-full? true, print-metadata? false, print-names? true, validate-query? false
printer print-formatted-event}}]
(binding [*print-full?* print-full?
*print-metadata?* print-metadata?
*print-names?* print-names?
*validate-query?* validate-query?
*printer* printer
pprint/*print-right-margin* 80]
(with-altered-middleware
(let [middleware (for [middleware-var (default-debug-middleware)
:when middleware-var]
(->> middleware-var
(debug-query-changes middleware-var)
(debug-metadata-changes middleware-var)
(debug-result-changes middleware-var)
(debug-row-changes middleware-var)))
qp (qp.reducible/sync-qp (#'qp/base-qp middleware))]
(if context
(qp query context)
(qp query)))))) |
[[to-mbql-shorthand]] | |
(defn- strip-$ [coll]
(into []
(map (fn [x] (if (= x ::$) ::no-$ x)))
coll)) | |
(defn- can-symbolize? [x]
(mbql.u/match-one x
(_ :guard string?)
(not (re-find #"\s+" x))
[:field (id :guard pos-int?) nil]
(every? can-symbolize? (field-and-table-name id))
[:field (field-name :guard string?) (opts :guard #(= (set (keys %)) #{:base-type}))]
(can-symbolize? field-name)
[:field _ (opts :guard :join-alias)]
(and (can-symbolize? (:join-alias opts))
(can-symbolize? (mbql.u/update-field-options &match dissoc :join-alias)))
[:field _ (opts :guard :temporal-unit)]
(and (can-symbolize? (name (:temporal-unit opts)))
(can-symbolize? (mbql.u/update-field-options &match dissoc :temporal-unit)))
[:field _ (opts :guard :source-field)]
(let [source-field-id (:source-field opts)]
(and (can-symbolize? [:field source-field-id nil])
(can-symbolize? (mbql.u/update-field-options &match dissoc :source-field))))
_
false)) | |
(defn- expand [form table]
(try
(mbql.u/replace form
([:field (id :guard pos-int?) nil] :guard can-symbolize?)
(let [[table-name field-name] (field-and-table-name id)
field-name (some-> field-name u/lower-case-en)
table-name (some-> table-name u/lower-case-en)]
(if (= table-name table)
[::$ field-name]
[::$ table-name field-name]))
([:field (field-name :guard string?) (opts :guard #(= (set (keys %)) #{:base-type}))] :guard can-symbolize?)
[::* field-name (name (:base-type opts))]
([:field _ (opts :guard :temporal-unit)] :guard can-symbolize?)
(let [without-unit (mbql.u/update-field-options &match dissoc :temporal-unit)
expansion (expand without-unit table)]
[::! (name (:temporal-unit opts)) (strip-$ expansion)])
([:field _ (opts :guard :source-field)] :guard can-symbolize?)
(let [without-source-field (mbql.u/update-field-options &match dissoc :source-field)
expansion (expand without-source-field table)
source-as-field-clause [:field (:source-field opts) nil]
source-expansion (expand source-as-field-clause table)]
[::-> source-expansion expansion])
([:field _ (opts :guard :join-alias)] :guard can-symbolize?)
(let [without-join-alias (mbql.u/update-field-options &match dissoc :join-alias)
expansion (expand without-join-alias table)]
[::& (:join-alias opts) expansion])
[:field (id :guard pos-int?) opts]
(let [without-opts [:field id nil]
expansion (expand without-opts table)]
(if (= expansion without-opts)
&match
[:field [::% (strip-$ expansion)] opts]))
(m :guard (every-pred map? (comp pos-int? :source-table)))
(-> (update m :source-table (fn [table-id]
[::$$ (some-> (t2/select-one-fn :name Table :id table-id) u/lower-case-en)]))
(expand table))
(m :guard (every-pred map? (comp pos-int? :fk-field-id)))
(-> (update m :fk-field-id (fn [fk-field-id]
(let [[table-name field-name] (field-and-table-name fk-field-id)
field-name (some-> field-name u/lower-case-en)
table-name (some-> table-name u/lower-case-en)]
(if (= table-name table)
[::% field-name]
[::% table-name field-name]))))
(expand table)))
(catch Throwable e
(throw (ex-info (format "Error expanding %s: %s" (pr-str form) (ex-message e))
{:form form, :table table}
e))))) | |
(defn- no-$ [x] (mbql.u/replace x [::$ & args] (into [::no-$] args))) | |
(defn- symbolize [form]
(mbql.u/replace form
[::-> x y]
(symbol (format "%s->%s" (symbolize x) (str/replace (symbolize y) #"^\$" )))
[::no-$ & args]
(str/join \. args)
[(qualifier :guard #{::$ ::& ::! ::%}) & args]
(symbol (str (name qualifier) (str/join \. (symbolize (no-$ args)))))
[::* field-name base-type]
(symbol (format "*%s/%s" field-name base-type))
[::$$ table-name]
(symbol (format "$$%s" table-name)))) | |
(defn- query-table-name [{:keys [source-table source-query], :as inner-query}]
(cond
(pos-int? source-table)
(u/lower-case-en (or (t2/select-one-fn :name Table :id source-table)
(throw (ex-info (format "Table %d does not exist!" source-table)
{:source-table source-table, :inner-query inner-query}))))
source-query
(recur source-query))) | |
(defn to-mbql-shorthand
([query]
(let [query (mbql.normalize/normalize query)]
(to-mbql-shorthand query (query-table-name (:query query)))))
([query table-name]
(let [symbolized (-> query (expand table-name) symbolize ->sorted-mbql-query-map)
table-symb (some-> table-name symbol)]
(if (:query symbolized)
(list 'mt/mbql-query table-symb (cond-> (:query symbolized)
table-name (dissoc :source-table)))
(list 'mt/$ids table-symb symbolized))))) | |
(defn expand-symbolize [x] (-> x (expand "orders") symbolize)) | |
tests are in [[dev.debug-qp-test]] (in | |
Pretty print a SQL string. | (defn pprint-sql
[driver sql]
#_{:clj-kondo/ignore [:discouraged-var]}
(println (mdb.query/format-sql sql driver))) |
(ns dev.debug-qp-test
(:require [clojure.test :refer :all]
[dev.debug-qp :as debug-qp]
[metabase.test :as mt])) | |
(deftest add-names-test
(testing "Joins"
(is (= [{:strategy :left-join
:alias "CATEGORIES__via__CATEGORY_ID"
:condition [:=
[:field
(mt/id :venues :category_id)
(symbol "#_\"VENUES.CATEGORY_ID\)
nil]
[:field
(mt/id :categories :id)
(symbol "#_\"CATEGORIES.ID\)
{:join-alias "CATEGORIES__via__CATEGORY_ID"}]]
:source-table (list 'do (symbol "#_\"CATEGORIES\) (mt/id :categories))
:fk-field-id (list 'do (symbol "#_\"VENUES.CATEGORY_ID\) (mt/id :venues :category_id))}]
(debug-qp/add-names
[{:strategy :left-join
:alias "CATEGORIES__via__CATEGORY_ID"
:condition [:=
[:field (mt/id :venues :category_id) nil]
[:field (mt/id :categories :id) {:join-alias "CATEGORIES__via__CATEGORY_ID"}]]
:source-table (mt/id :categories)
:fk-field-id (mt/id :venues :category_id)}]))))) | |
(deftest to-mbql-shorthand-test
(mt/dataset test-data
(testing "Normal Field ID clause"
(is (= '$user_id
(debug-qp/expand-symbolize [:field (mt/id :orders :user_id) nil])))
(is (= '$products.id
(debug-qp/expand-symbolize [:field (mt/id :products :id) nil]))))
(testing "Field literal name"
(is (= '*wow/Text
(debug-qp/expand-symbolize [:field "wow" {:base-type :type/Text}])))
(is (= [:field "w o w" {:base-type :type/Text}]
(debug-qp/expand-symbolize [:field "w o w" {:base-type :type/Text}]))))
(testing "Field with join alias"
(is (= '&P.people.source
(debug-qp/expand-symbolize [:field (mt/id :people :source) {:join-alias "P"}])))
(is (= [:field '%people.id {:join-alias "People - User"}]
(debug-qp/expand-symbolize [:field (mt/id :people :id) {:join-alias "People - User"}])))
(is (= '&Q.*ID/BigInteger
(debug-qp/expand-symbolize [:field "ID" {:base-type :type/BigInteger, :join-alias "Q"}]))))
(testing "Field with source-field"
(is (= '$product_id->products.id
(debug-qp/expand-symbolize [:field (mt/id :products :id) {:source-field (mt/id :orders :product_id)}])))
(is (= '$product_id->*wow/Text
(debug-qp/expand-symbolize [:field "wow" {:base-type :type/Text, :source-field (mt/id :orders :product_id)}]))))
(testing "Binned field - no expansion (%id only)"
(is (= [:field '%people.source {:binning {:strategy :default}}]
(debug-qp/expand-symbolize [:field (mt/id :people :source) {:binning {:strategy :default}}]))))
(testing "Field with temporal unit"
(is (= '!default.created_at
(debug-qp/expand-symbolize [:field (mt/id :orders :created_at) {:temporal-unit :default}]))))
(testing "Field with join alias AND temporal unit"
(is (= '!default.&P1.created_at
(debug-qp/expand-symbolize [:field (mt/id :orders :created_at) {:temporal-unit :default, :join-alias "P1"}]))))
(testing "source table"
(is (= '(mt/mbql-query orders
{:joins [{:source-table $$people}]})
(debug-qp/to-mbql-shorthand
{:database (mt/id)
:type :query
:query {:source-table (mt/id :orders)
:joins [{:source-table (mt/id :people)}]}})))))) | |
(deftest to-mbql-shorthand-joins-test
(testing :fk-field-id
(is (= '(mt/$ids venues
[{:strategy :left-join
:alias "CATEGORIES__via__CATEGORY_ID"
:condition [:= $category_id &CATEGORIES__via__CATEGORY_ID.categories.id]
:source-table $$categories
:fk-field-id %category_id}])
(debug-qp/to-mbql-shorthand
[{:strategy :left-join
:alias "CATEGORIES__via__CATEGORY_ID"
:condition [:=
[:field (mt/id :venues :category_id) nil]
[:field (mt/id :categories :id) {:join-alias "CATEGORIES__via__CATEGORY_ID"}]]
:source-table (mt/id :categories)
:fk-field-id (mt/id :venues :category_id)}]
"venues"))))) | |
(ns dev.explain (:require [clojure.string :as str] [honey.sql :as sql] [toucan2.core :as t2])) | |
Explain a sql query or a honeysql query with option to analyze the query. | (defn explain-query
([queryable]
(explain-query queryable false))
([queryable analyze?]
(->> (t2/query
(str/join
" "
(remove nil? ["EXPLAIN"
(when analyze? "ANALYZE")
"(" (if (map? queryable) (first (sql/format queryable {:inline true})) queryable) ")"])))
(map #(get % (keyword "query plan")))))) |
(ns dev.fe-helpers) | |
Returns the root Redux state, the JS object holding the complete state of the app. This is hacky - it reaches deep into the internals of Redux, and may break in the future. That seems acceptable for a dev time helper. | (defn redux-state
[]
(let [root (js/document.querySelector "#root")
store (.. root -_reactRootContainer -_internalRoot -current -child -memoizedProps -store)]
(.getState store))) |
Retrieves the current query's card from the Redux state. Undefined behavior if there is not currently a single question loaded in the UI. | (defn current-card [] (.. (redux-state) -qb -card)) |
Gets the legacy query for the currently loaded question. | (defn current-legacy-query-js [] (.-dataset_query (current-card))) |
Gets the MLv2 query for the currently loaded question. Hack: This relies on a dev-mode-only global property that's set whenever a Question object is converted to MLv2. | (defn current-query [] (.-__MLv2_query js/window)) |
(ns dev.h2-shell
(:require [environ.core :as env]
[metabase.db.data-source :as mdb.data-source]
[metabase.db.env :as mdb.env])) | |
(comment mdb.data-source/keep-me) | |
Open an H2 shell with | (defn shell
[& _args]
;; Force the DB to use h2 regardless of what's actually in the env vars for Java properties
(alter-var-root #'env/env assoc :mb-db-type "h2")
(require 'metabase.db.env :reload)
(org.h2.tools.Shell/main
(into-array
String
["-url" (let [^metabase.db.data_source.DataSource data-source mdb.env/data-source
url (.url data-source)]
(println "Connecting to database at URL" url)
url)]))) |
(ns dev.liquibase
(:require [clojure.string :as str]
[colorize.core :as colorize]
[metabase.db.data-source :as mdb.data-source]
[metabase.db.env :as mdb.env])) | |
(comment mdb.data-source/keep-me) | |
Use the Liquibase CLI with | (defn -main
[& args]
(let [args (if (empty? args)
["help"]
args)
args (into ["--changeLogFile=resources/migrations/000_migrations.yaml"]
(comp cat
(filter seq))
(let [^metabase.db.data_source.DataSource data-source mdb.env/data-source
^java.util.Properties properties (.properties data-source)]
[(when-let [user (some-> properties (.get "user"))]
["--username" user])
(when-let [password (some-> properties (.get "password"))]
["--password" password])
["--url" (.url data-source)]
(map str args)]))]
(println (colorize/green (str/join " " (cons "liquibase" (map pr-str args)))))
;; use reflection here instead of static method calls because `liquibase.integration.commandline.Main` fails to load
;; without having the `logback` dependency available. We add this as `:extra-deps` for the `:liquibase` profile. We
;; don't want other stuff like the linters to choke here tho.
(let [klass (Class/forName "liquibase.integration.commandline.Main")
method (.getMethod klass "main" (into-array Class [(Class/forName "[Ljava.lang.String;")]))]
(.invoke method klass ^"[Ljava.lang.Object" (into-array Object [(into-array String args)]))))) |
A set of utility function to track model changes. Use this when you want to observe changes of database models when doing stuffs on UI. How to use this?
You can use [[reset-changes!]] to clear our all the current trackings. And [[untrack-all!]] or [[untrack!]] to stop tracking. | (ns dev.model-tracking (:require [clojure.pprint :as pprint] [metabase.util :as u] [methodical.core :as m] [toucan2.core :as t2] [toucan2.model :as t2.model] [toucan2.tools.before-delete :as t2.before-delete] [toucan2.tools.before-insert :as t2.before-insert] [toucan2.tools.before-update :as t2.before-update] [toucan2.util :as t2.util])) |
An atom to store all the changes of models that we currently track. | (def changes*
(atom {})) |
(def ^:private tracked-models (atom #{})) | |
When a change occurred, execute this function. Currently it just prints the console out to the console. But if you prefer other method of debugging (i.e: tap), you can redef this function (alter-var-root #'model-tracking/on-change (fn [path change] (tap> [path change])))
| (defn on-change [path change-info] (println (u/colorize :magenta :new-change) (u/colorize :magenta path)) (pprint/pprint change-info)) |
(defn- clean-change [change] (dissoc change :updated_at :created_at)) | |
Add a change to the [[changes]] atom.
For insert, track the instance as a map. For update, only track the changes. | (defn- new-change
[model action row-or-instance]
(let [model (t2/resolve-model model)
change-info (->> (case action
:update
(into {} (t2/changes row-or-instance))
(into {} row-or-instance))
clean-change)
path [(t2/table-name model) action]]
;; ideally this should be debug, but for some reasons this doesn't get logged
(on-change path change-info)
(swap! changes* update-in path concat [change-info]))) |
(defn- new-change-thunk
[model action]
(fn [_model row]
(new-change model action row)
row)) | |
A list of toucan hooks that we will subscribed to when tracking a model. | (def ^:private hook+aux-method+action+deriveable [;; will be better if we could use after-insert to get the inserted id, but toucan2 doesn't define a multimethod for after-insert [#'t2.before-insert/before-insert :after :insert ::t2.before-insert/before-insert] [#'t2.before-update/before-update :after :update ::t2.before-update/before-update] ;; we do :before aux-method instead of :after for delete bacause the after method has input is number of affected rows [#'t2.before-delete/before-delete :before :delete ::t2.before-delete/before-delete]]) |
(defn- track-one!
[model]
(doseq [[hook aux-method action deriveable] hook+aux-method+action+deriveable]
(when-not (m/primary-method @hook model)
;; aux-method will not be triggered if there isn't a primary method
(t2.util/maybe-derive model deriveable)
(m/add-primary-method! hook model (fn [_ _model row] row)))
(m/add-aux-method-with-unique-key! hook aux-method model (new-change-thunk model action) ::tracking))) | |
Start tracking a list of models. (track! 'Card 'Dashboard) | (defn track!
[& models]
(doseq [model (map t2.model/resolve-model models)]
(track-one! model)
(swap! tracked-models conj model))) |
(defn- untrack-one!
[model]
(doseq [[hook aux-method _action] hook+aux-method+action+deriveable]
(m/remove-aux-method-with-unique-key! hook aux-method model ::tracking)
(swap! tracked-models disj model))) | |
Remove tracking for a list of models. (untrack! 'Card 'Dashboard) | (defn untrack!
[& models]
(doseq [model (map t2.model/resolve-model models)]
(untrack-one! model))) |
Empty all the recorded changes. | (defn reset-changes!
[]
(reset! changes* {})) |
Quickly untrack all the tracked models. | (defn untrack-all!
[]
(reset-changes!)
(apply untrack! @tracked-models)
(reset! tracked-models #{})) |
Return all changes that were recorded. | (defn changes [] @changes*) |
(ns dev.model-tracking-test (:require [clojure.test :refer :all] [dev.model-tracking :as model-tracking] [metabase.models :refer [Collection]] [metabase.test :as mt] [toucan2.core :as t2])) | |
(use-fixtures :each (fn [thunk]
(model-tracking/untrack-all!)
(thunk))) | |
(deftest e2e-test
(mt/with-model-cleanup [Collection]
;; setup
(model-tracking/track! 'Collection)
(testing "insert"
(t2/insert! Collection {:name "Test tracking" :description "My awesome collection"})
(testing "should be tracked"
(is (=? [{:name "Test tracking"
:description "My awesome collection"}]
(get-in (model-tracking/changes) [:collection :insert]))))
(testing "should take affects"
(is (= 1 (t2/count Collection :name "Test tracking")))))
(testing "update"
(t2/update! Collection {:name "Test tracking"} {:description "Amazing collection"})
(testing "changes should be tracked"
(is (= [{:description "Amazing collection"}]
(get-in (model-tracking/changes) [:collection :update]))))
(testing "should take affects"
(is (= "Amazing collection" (t2/select-one-fn :description Collection :name "Test tracking")))))
(testing "delete"
(let [coll-id (t2/select-one-pk Collection :name "Test tracking")]
(t2/delete! Collection coll-id)
(testing "should be tracked"
(is (=? [{:description "Amazing collection"
:name "Test tracking",
:id coll-id}]
(get-in (model-tracking/changes) [:collection :delete]))))
(testing "should take affects"
(is (nil? (t2/select-one Collection :id coll-id))))))
(testing "untrack should stop all tracking for"
(model-tracking/untrack-all!)
(testing "insert"
(t2/insert! Collection {:name "Test tracking" :description "My awesome collection"})
(testing "changes not should be tracked"
(is (empty? (model-tracking/changes))))
(testing "should take affects"
(is (= 1 (t2/count Collection :name "Test tracking")))))
(testing "update"
(t2/update! Collection {:name "Test tracking"} {:description "Amazing collection"})
(testing "changes not should be tracked"
(is (empty? (model-tracking/changes))))
(testing "should take affects"
(is (= "Amazing collection" (t2/select-one-fn :description Collection :name "Test tracking")))))
(testing "delete"
(let [coll-id (t2/select-one-pk Collection :name "Test tracking")]
(t2/delete! Collection coll-id)
(testing "changes not should be tracked"
(is (empty? (model-tracking/changes))))
(testing "should take affects"
(is (nil? (t2/select-one Collection :id coll-id))))))))) | |
(ns dev.portal (:require [portal.api :as p])) | |
The handle to portal. Can be used as @p to get the selected item. | (defonce
p
(p/open {:port 5678})) |
Listen by default. | (add-tap #'p/submit) |
Register some useful functions for use in the portal window. | (doseq [f [#'reverse #'vec]] (p/register! f)) |
Sometimes the portal window stops responding. Closing the window and running this function brings up a new, responsive window preserving the contents. | (defn unfreeze [] (p/open p)) |
Tap The options :level, :ns, :line, :column and :time can be used to override the defaults (:info level, the current namespace, line -1, column -1 and the current time.) | (defn send-log
([value] (send-log value nil))
([value {:keys [level ns line column time]
:or {level :info
ns (ns-name *ns*)
line -1
column -1
time (java.util.Date.)}}]
(tap> {:result value
:level level
:ns ns
:line line
:column column
:time time}))) |
Send | (defmacro log
[value & [opts]]
`(send-log ~value ~(merge (meta &form)
{:ns (list 'quote (ns-name *ns*))}
opts))) |
Sends debug events from This is a simplistic function that send known transformation events to portal as a log message. The diff of the second and third parameters form the message and the location of the definition of the var in the first parameter is used as origin. Any other events are sent to portal as is. A typical use looks like this: (debug-qp/process-query-debug a-query :printer portal/debug-qp-log) | (defn debug-qp-log
[[tag middleware-var before after :as event]]
(if (#{:dev.debug-qp/transformed-query, :dev.debug-qp/transformed-metadata
:dev.debug-qp/transformed-result, :dev.debug-qp/transformed-row}
tag)
(send-log (with-meta [before after]
{:portal.viewer/default :portal.viewer/diff})
(update (meta middleware-var) :ns #(.name %)))
(send-log event))) |
Improve feedback loop for dealing with png rendering code. Will create images using the rendering that underpins pulses and subscriptions and open those images without needing to send them to slack or email. | (ns dev.render-png
(:require
[clojure.data.csv :as csv]
[clojure.java.io :as io]
[clojure.java.shell :as sh]
[hiccup.core :as hiccup]
[metabase.email.messages :as messages]
[metabase.models :refer [Card]]
[metabase.models.card :as card]
[metabase.pulse :as pulse]
[metabase.pulse.markdown :as markdown]
[metabase.pulse.render :as render]
[metabase.pulse.render.image-bundle :as img]
[metabase.pulse.render.png :as png]
[metabase.pulse.render.style :as style]
[metabase.query-processor :as qp]
[metabase.test :as mt]
[toucan2.core :as t2])
(:import (java.io File))) |
(set! *warn-on-reflection* true) | |
Returns :win, :mac, :unix, or nil taken from https://github.com/aysylu/loom/blob/master/src/loom/io.clj | (defn- os
[]
(condp
#(<= 0 (.indexOf ^String %2 ^String %1))
(.toLowerCase (System/getProperty "os.name"))
"win" :win
"mac" :mac
"nix" :unix
"nux" :unix
nil)) |
Opens the given file (a string, File, or file URI) in the default application for the current desktop environment. Returns nil taken from https://github.com/aysylu/loom/blob/master/src/loom/io.clj | (defn- open
[f]
(let [f (io/file f)]
;; There's an 'open' method in java.awt.Desktop but it hangs on Windows
;; using Clojure Box and turns the process into a GUI process on Max OS X.
;; Maybe it's ok for Linux?
(condp = (os)
:mac (sh/sh "open" (str f))
:win (sh/sh "cmd" (str "/c start " (-> f .toURI .toURL str)))
:unix (sh/sh "xdg-open" (str f)))
nil)) |
Given a card ID, renders the card to a png and opens it. Be aware that the png rendered on a dev machine may not match what's rendered on another system, like a docker container. | (defn render-card-to-png
[card-id]
(let [{:keys [dataset_query result_metadata dataset] :as card} (t2/select-one card/Card :id card-id)
query-results (qp/process-query
(cond-> dataset_query
dataset
(assoc-in [:info :metadata/dataset-metadata] result_metadata)))
png-bytes (render/render-pulse-card-to-png (pulse/defaulted-timezone card)
card
query-results
1000)
tmp-file (File/createTempFile "card-png" ".png")]
(with-open [w (java.io.FileOutputStream. tmp-file)]
(.write w ^bytes png-bytes))
(.deleteOnExit tmp-file)
(open tmp-file))) |
Render a pulse card as a data structure | (defn render-pulse-card
[card-id]
(let [{:keys [dataset_query] :as card} (t2/select-one card/Card :id card-id)
query-results (qp/process-query dataset_query)]
(render/render-pulse-card
:inline (pulse/defaulted-timezone card)
card
nil
query-results))) |
Take a hiccup data structure, render it as html, then open it in the browser. | (defn open-hiccup-as-html
[hiccup]
(let [html-str (hiccup/html hiccup)
tmp-file (File/createTempFile "card-html" ".html")]
(with-open [w (io/writer tmp-file)]
(.write w ^String html-str))
(.deleteOnExit tmp-file)
(open tmp-file))) |
(def ^:private execute-dashboard #'pulse/execute-dashboard) | |
Given a dashboard ID, renders each dashcard, including Markdown, to its own temporary png image, and opens each one. | (defn render-dashboard-to-pngs
[dashboard-id]
(let [user (t2/select-one :model/User)
dashboard (t2/select-one :model/Dashboard :id dashboard-id)
dashboard-results (execute-dashboard {:creator_id (:id user)} dashboard)]
(doseq [{:keys [card dashcard result] :as dashboard-result} dashboard-results]
(let [render (if card
(render/render-pulse-card :inline (pulse/defaulted-timezone card) card dashcard result)
{:content [:div {:style (style/style {:font-family "Lato"
:font-size "0.875em"
:font-weight "400"
:font-style "normal"
:color "#4c5773"
:-moz-osx-font-smoothing "grayscale"})}
(markdown/process-markdown (:text dashboard-result) :html)]
:attachments nil})
png-bytes (-> render (png/render-html-to-png 1000))
tmp-file (java.io.File/createTempFile "card-png" ".png")]
(with-open [w (java.io.FileOutputStream. tmp-file)]
(.write w ^bytes png-bytes))
(.deleteOnExit tmp-file)
(open tmp-file))))) |
(def ^:private table-style-map
{:border "1px solid black"
:border-collapse "collapse"
:padding "5px"}) | |
(def ^:private table-style (style/style table-style-map)) | |
(def ^:private csv-row-limit 10) | |
(defn- csv-to-html-table [csv-string]
(let [rows (csv/read-csv csv-string)]
[:table {:style table-style}
(for [row (take (inc csv-row-limit) rows)] ;; inc row-limit to include the header and the expected # of rows
[:tr {:style table-style}
(for [cell row]
[:td {:style table-style} cell])])])) | |
(def ^:private result-attachment #'messages/result-attachment) | |
(defn- render-csv-for-dashcard
[part]
(-> part
(assoc-in [:card :include_csv] true)
result-attachment
first
:content
slurp
csv-to-html-table)) | |
(defn- render-one-dashcard
[{:keys [card dashcard result] :as dashboard-result}]
(letfn [(cellfn [content]
[:td {:style (style/style (merge table-style-map {:max-width "400px"}))}
content])]
(if card
(let [base-render (render/render-pulse-card :inline (pulse/defaulted-timezone card) card dashcard result)
html-src (-> base-render :content)
img-src (-> base-render
(png/render-html-to-png 1200)
img/render-img-data-uri)
csv-src (render-csv-for-dashcard dashboard-result)]
[:tr
(cellfn (:name card))
(cellfn [:img {:style (style/style {:max-width "400px"}) :src img-src}])
(cellfn html-src)
(cellfn csv-src)])
[:tr
(cellfn nil)
(cellfn
[:div {:style (style/style {:font-family "Lato"
:font-size "13px" #_ "0.875em"
:font-weight "400"
:font-style "normal"
:color "#4c5773"
:-moz-osx-font-smoothing "grayscale"})}
(markdown/process-markdown (:text dashboard-result) :html)])
(cellfn nil)]))) | |
Given a dashboard ID, renders all of the dashcards to hiccup datastructure. | (defn render-dashboard-to-hiccup
[dashboard-id]
(let [user (t2/select-one :model/User)
dashboard (t2/select-one :model/Dashboard :id dashboard-id)
dashboard-results (execute-dashboard {:creator_id (:id user)} dashboard)
render (->> (map render-one-dashcard (map #(assoc % :dashboard-id dashboard-id) dashboard-results))
(into [[:tr
[:th {:style (style/style table-style-map)} "Card Name"]
[:th {:style (style/style table-style-map)} "PNG"]
[:th {:style (style/style table-style-map)} "HTML"]
[:th {:style (style/style table-style-map)} "CSV"]]])
(into [:table {:style (style/style table-style-map)}]))]
render)) |
Given a dashboard ID, renders all of the dashcards into an html document. | (defn render-dashboard-to-html [dashboard-id] (hiccup/html (render-dashboard-to-hiccup dashboard-id))) |
Given a dashboard ID, renders all of the dashcards to an html file and opens it. | (defn render-dashboard-to-html-and-open
[dashboard-id]
(let [html-str (render-dashboard-to-html dashboard-id)
tmp-file (File/createTempFile "card-html" ".html")]
(with-open [w (io/writer tmp-file)]
(.write w ^String html-str))
(.deleteOnExit tmp-file)
(open tmp-file))) |
(comment
;; This form has 3 cards:
;; - A plain old question
;; - A model with user defined metadata
;; - A question based on that model
;;
;; The expected rendered results should be:
;; - The plain question will not have custom formatting applied
;; - The model and derived query will have custom formatting applied
(mt/dataset sample-dataset
(mt/with-temp [Card {base-card-id :id}
{:dataset_query {:database (mt/id)
:type :query
:query {:source-table (mt/id :orders)
:expressions {"Tax Rate" [:/
[:field (mt/id :orders :tax) {:base-type :type/Float}]
[:field (mt/id :orders :total) {:base-type :type/Float}]]},
:fields [[:field (mt/id :orders :tax) {:base-type :type/Float}]
[:field (mt/id :orders :total) {:base-type :type/Float}]
[:expression "Tax Rate"]]
:limit 10}}}
Card {model-card-id :id} {:dataset true
:dataset_query {:type :query
:database (mt/id)
:query {:source-table (format "card__%s" base-card-id)}}
:result_metadata [{:name "TAX"
:display_name "Tax"
:base_type :type/Float}
{:name "TOTAL"
:display_name "Total"
:base_type :type/Float}
{:name "Tax Rate"
:display_name "Tax Rate"
:base_type :type/Float
:semantic_type :type/Percentage
:field_ref [:field "Tax Rate" {:base-type :type/Float}]}]}
Card {question-card-id :id} {:dataset_query {:type :query
:database (mt/id)
:query {:source-table (format "card__%s" model-card-id)}}}]
(render-card-to-png base-card-id)
(render-card-to-png model-card-id)
(render-card-to-png question-card-id)))) | |
(ns user (:require [environ.core :as env] [humane-are.core :as humane-are] [mb.hawk.assert-exprs] [metabase.bootstrap] [metabase.test-runner.assert-exprs] [pjstadig.humane-test-output :as humane-test-output])) | |
Initialize Humane Test Output if it's not already initialized. Don't enable humane-test-output when running tests from the CLI, it breaks diffs. This uses [[env/env]] rather than [[metabase.config]] so we don't load that namespace before we load [[metabase.bootstrap]] | (when-not (= (env/env :mb-run-mode) "test") (humane-test-output/activate!)) |
Same for https://github.com/camsaul/humane-are | (humane-are/install!) |
(comment metabase.bootstrap/keep-me
;; make sure stuff like `=?` and what not are loaded
mb.hawk.assert-exprs/keep-me
metabase.test-runner.assert-exprs/keep-me) | |
Load and switch to the 'dev' namespace. | (defn dev [] (require 'dev) (in-ns 'dev) :loaded) |
(ns metabase.lib.metadata.cached-provider (:require [clojure.set :as set] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.protocols :as lib.metadata.protocols] [metabase.lib.schema.common :as lib.schema.common] [metabase.util :as u] [metabase.util.log :as log] [metabase.util.malli :as mu] #?@(:clj ([pretty.core :as pretty])))) | |
(defn- get-in-cache [cache ks]
(when-some [cached-value (get-in @cache ks)]
(when-not (= cached-value ::nil)
cached-value))) | |
(defn- store-in-cache! [cache ks value]
(let [value (if (some? value) value ::nil)]
(swap! cache assoc-in ks value)
(when-not (= value ::nil)
value))) | |
(mu/defn ^:private store-database!
[cache
database-metadata :- lib.metadata/DatabaseMetadata]
(let [database-metadata (-> database-metadata
(update-keys u/->kebab-case-en)
(assoc :lib/type :metadata/database))]
(store-in-cache! cache [:metadata/database] database-metadata))) | |
(mu/defn ^:private store-metadata!
[cache
metadata-type :- [:enum :metadata/database :metadata/table :metadata/column :metadata/card :metadata/metric :metadata/segment]
id :- ::lib.schema.common/positive-int
metadata :- [:multi
{:dispatch :lib/type}
[:metadata/database lib.metadata/DatabaseMetadata]
[:metadata/table lib.metadata/TableMetadata]
[:metadata/column lib.metadata/ColumnMetadata]
[:metadata/card lib.metadata/CardMetadata]
[:metadata/metric lib.metadata/MetricMetadata]
[:metadata/segment lib.metadata/SegmentMetadata]]]
(let [metadata (-> metadata
(update-keys u/->kebab-case-en)
(assoc :lib/type metadata-type))]
(store-in-cache! cache [metadata-type id] metadata))) | |
(defn- get-in-cache-or-fetch [cache ks fetch-thunk]
(if-some [cached-value (get-in @cache ks)]
(when-not (= cached-value ::nil)
cached-value)
(store-in-cache! cache ks (fetch-thunk)))) | |
(defn- bulk-metadata [cache uncached-provider metadata-type ids]
(when (seq ids)
(log/debugf "Getting %s metadata with IDs %s" metadata-type (pr-str (sort ids)))
(let [existing-ids (set (keys (get @cache metadata-type)))
missing-ids (set/difference (set ids) existing-ids)]
(log/debugf "Already fetched %s: %s" metadata-type (pr-str (sort (set/intersection (set ids) existing-ids))))
(when (seq missing-ids)
(log/debugf "Need to fetch %s: %s" metadata-type (pr-str (sort missing-ids)))
;; TODO -- we should probably store `::nil` markers for things we tried to fetch that didn't exist
(doseq [instance (lib.metadata.protocols/bulk-metadata uncached-provider metadata-type missing-ids)]
(store-in-cache! cache [metadata-type (:id instance)] instance))))
(for [id ids]
(get-in-cache cache [metadata-type id])))) | |
(defn- tables [metadata-provider cache]
(let [fetched-tables #(lib.metadata.protocols/tables metadata-provider)]
(doseq [table fetched-tables]
(store-in-cache! cache [:metadata/table (:id table)] table))
fetched-tables)) | |
(defn- fields [metadata-provider cache table-id]
(let [fetched-fields (lib.metadata.protocols/fields metadata-provider table-id)]
(doseq [field fetched-fields]
(store-in-cache! cache [:metadata/column (:id field)] field))
fetched-fields)) | |
(defn- metrics [metadata-provider cache table-id]
(let [fetched-metrics (lib.metadata.protocols/metrics metadata-provider table-id)]
(doseq [metric fetched-metrics]
(store-in-cache! cache [:metadata/metric (:id metric)] metric))
fetched-metrics)) | |
wraps another metadata provider and caches results. Implements the [[lib.metadata.protocols/CachedMetadataProvider]] protocol which allows warming the cache before use. | (deftype CachedProxyMetadataProvider [cache metadata-provider]
lib.metadata.protocols/MetadataProvider
(database [_this] (get-in-cache-or-fetch cache [:metadata/database] #(lib.metadata.protocols/database metadata-provider)))
(table [_this table-id] (get-in-cache-or-fetch cache [:metadata/table table-id] #(lib.metadata.protocols/table metadata-provider table-id)))
(field [_this field-id] (get-in-cache-or-fetch cache [:metadata/column field-id] #(lib.metadata.protocols/field metadata-provider field-id)))
(card [_this card-id] (get-in-cache-or-fetch cache [:metadata/card card-id] #(lib.metadata.protocols/card metadata-provider card-id)))
(metric [_this metric-id] (get-in-cache-or-fetch cache [:metadata/metric metric-id] #(lib.metadata.protocols/metric metadata-provider metric-id)))
(segment [_this segment-id] (get-in-cache-or-fetch cache [:metadata/segment segment-id] #(lib.metadata.protocols/segment metadata-provider segment-id)))
(tables [_this] (get-in-cache-or-fetch cache [::database-tables] #(tables metadata-provider cache)))
(fields [_this table-id] (get-in-cache-or-fetch cache [::table-fields table-id] #(fields metadata-provider cache table-id)))
(metrics [_this table-id] (get-in-cache-or-fetch cache [::table-metrics table-id] #(metrics metadata-provider cache table-id)))
(setting [_this setting] (lib.metadata.protocols/setting metadata-provider setting))
lib.metadata.protocols/CachedMetadataProvider
(cached-database [_this] (get-in-cache cache [:metadata/database]))
(cached-metadata [_this metadata-type id] (get-in-cache cache [metadata-type id]))
(store-database! [_this database-metadata] (store-database! cache database-metadata))
(store-metadata! [_this metadata-type id metadata] (store-metadata! cache metadata-type id metadata))
;; these only work if the underlying metadata provider is also a [[BulkMetadataProvider]].
lib.metadata.protocols/BulkMetadataProvider
(bulk-metadata [_this metadata-type ids]
(bulk-metadata cache metadata-provider metadata-type ids))
#?@(:clj
[pretty/PrettyPrintable
(pretty [_this]
(list `cached-metadata-provider metadata-provider))])) |
Wrap If the metadata provider implements [[lib.metadata.protocols/BulkMetadataProvider]], then [[lib.metadata.protocols/bulk-metadata]] will work as expected; it can be done for side-effects as well. | (defn cached-metadata-provider
^CachedProxyMetadataProvider [metadata-provider]
(->CachedProxyMetadataProvider (atom {}) metadata-provider)) |
(ns metabase.lib.metadata.calculation
(:require
#?(:clj [metabase.config :as config])
[clojure.string :as str]
[metabase.lib.cache :as lib.cache]
[metabase.lib.dispatch :as lib.dispatch]
[metabase.lib.hierarchy :as lib.hierarchy]
[metabase.lib.join.util :as lib.join.util]
[metabase.lib.metadata :as lib.metadata]
[metabase.lib.options :as lib.options]
[metabase.lib.schema :as lib.schema]
[metabase.lib.schema.common :as lib.schema.common]
[metabase.lib.schema.expression :as lib.schema.expresssion]
[metabase.lib.schema.metadata :as lib.schema.metadata]
[metabase.lib.schema.temporal-bucketing
:as lib.schema.temporal-bucketing]
[metabase.lib.types.isa :as lib.types.isa]
[metabase.lib.util :as lib.util]
[metabase.shared.util.i18n :as i18n]
[metabase.util :as u]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.malli.registry :as mr])) | |
Schema for valid values of
| (def DisplayNameStyle [:enum :default :long]) |
Display name style to use when not explicitly passed in to [[display-name]]. | (def ^:dynamic *display-name-style* :default) |
Calculate a nice human-friendly display name for something. | (defmulti display-name-method
{:arglists '([query stage-number x display-name-style])}
(fn [_query _stage-number x _display-name-style]
(lib.dispatch/dispatch-value x))
:hierarchy lib.hierarchy/hierarchy) |
Calculate a database-friendly name to use for something. | (defmulti column-name-method
{:arglists '([query stage-number x])}
(fn [_query _stage-number x]
(lib.dispatch/dispatch-value x))
:hierarchy lib.hierarchy/hierarchy) |
(mu/defn ^:export display-name :- :string
"Calculate a nice human-friendly display name for something. See [[DisplayNameStyle]] for a the difference between
different `style`s."
([query]
(display-name query query))
([query x]
(display-name query -1 x))
([query stage-number x]
(display-name query stage-number x *display-name-style*))
([query :- ::lib.schema/query
stage-number :- :int
x
style :- DisplayNameStyle]
(or
;; if this is an MBQL clause with `:display-name` in the options map, then use that rather than calculating a name.
((some-fn :display-name :lib/expression-name) (lib.options/options x))
(try
(display-name-method query stage-number x style)
(catch #?(:clj Throwable :cljs js/Error) e
(throw (ex-info (i18n/tru "Error calculating display name for {0}: {1}" (pr-str x) (ex-message e))
{:query query, :x x}
e))))))) | |
(mu/defn column-name :- ::lib.schema.common/non-blank-string
"Calculate a database-friendly name to use for an expression."
([query x]
(column-name query -1 x))
([query :- ::lib.schema/query
stage-number :- :int
x]
(or
;; if this is an MBQL clause with `:name` in the options map, then use that rather than calculating a name.
(:name (lib.options/options x))
(try
(column-name-method query stage-number x)
(catch #?(:clj Throwable :cljs js/Error) e
(throw (ex-info (i18n/tru "Error calculating column name for {0}: {1}" (pr-str x) (ex-message e))
{:x x
:query query
:stage-number stage-number}
e))))))) | |
(defmethod display-name-method :default
[_query _stage-number x _stage]
;; This was suspected as hurting performance, going to skip it in prod for now
(when #?(:clj (not config/is-prod?)
:cljs true ;; the linter complains when :cljs is not here(?)
:cljs-dev true
:cljs-release false)
(log/warnf "Don't know how to calculate display name for %s. Add an impl for %s for %s"
(pr-str x)
`display-name-method
(lib.dispatch/dispatch-value x)))
(if (and (vector? x)
(keyword? (first x)))
;; MBQL clause: just use the name of the clause.
(name (first x))
;; anything else: use `pr-str` representation.
(pr-str x))) | |
TODO -- this logic is wack, we should probably be snake casing stuff and display names like "Sum of Products → Price" result in totally wacko column names like "sumproducts%E2%86%92_price", let's try to generate things that are actually going to be allowed here. | (defn- slugify [s]
(-> s
(str/replace #"[\(\)]" )
(u/slugify {:unicode? true}))) |
default impl just takes the display name and slugifies it. | (defmethod column-name-method :default [query stage-number x] (slugify (display-name query stage-number x))) |
Implementation for [[describe-top-level-key]]. Describe part of a stage of a query, e.g. the Implementations that call [[display-name]] should specify the | (defmulti describe-top-level-key-method
{:arglists '([query stage-number top-level-key])}
(fn [_query _stage-number top-level-key]
top-level-key)
:hierarchy lib.hierarchy/hierarchy) |
In the interest of making this easy to use in JS-land we'll accept either strings or keywords. | (def ^:private TopLevelKey [:enum :aggregation :breakout :filters :limit :order-by :source-table :source-card :joins]) |
(mu/defn describe-top-level-key :- [:maybe ::lib.schema.common/non-blank-string]
"'top-level' here means the top level of an individual stage. Generate a human-friendly string describing a specific
part of an MBQL stage, or `nil` if that part doesn't exist."
([query top-level-key]
(describe-top-level-key query -1 top-level-key))
([query :- ::lib.schema/query
stage-number :- :int
top-level-key :- TopLevelKey]
(describe-top-level-key-method query stage-number (keyword top-level-key)))) | |
Calculate the effective type of something. This differs from [[metabase.lib.schema.expression/type-of]] in that it is called with a query/MetadataProvider and a stage number, allowing us to fully resolve information and return complete, unambigous type information. Default implementation calls [[metabase.lib.schema.expression/type-of]]. | (defmulti type-of-method
{:arglists '([query stage-number expr])}
(fn [_query _stage-number expr]
(lib.dispatch/dispatch-value expr))
:hierarchy lib.hierarchy/hierarchy) |
(mu/defn type-of :- ::lib.schema.common/base-type
"Get the effective type of an MBQL expression."
([query x]
(type-of query -1 x))
([query :- ::lib.schema/query
stage-number :- :int
x]
;; this logic happens here so we don't need to code up every single individual method to handle these special
;; cases.
(let [{:keys [temporal-unit], :as options} (lib.options/options x)]
(or
;; If the options map includes `:effective-type` we can assume you know what you are doing and that it is
;; correct and just return it directly.
(:effective-type options)
;; If `:temporal-unit` is specified (currently only supported by `:field` clauses), we should return
;; `:type/Integer` if its an extraction operation, e.g. `:month-of-year` always returns an integer; otherwise we
;; can return `:base-type`.
(when (and temporal-unit
(contains? lib.schema.temporal-bucketing/datetime-extraction-units temporal-unit))
:type/Integer)
;; otherwise if `:base-type` is specified, we can return that.
(:base-type options)
;; if none of the special cases are true, fall back to [[type-of-method]].
(let [calculated-type (type-of-method query stage-number x)]
;; if calculated type is not a true type but a placeholder like `:metabase.lib.schema.expression/type.unknown`
;; or a union of types then fall back to `:type/*`, an actual type.
(if (isa? calculated-type :type/*)
calculated-type
:type/*)))))) | |
(defmethod type-of-method :default [_query _stage-number expr] (lib.schema.expresssion/type-of expr)) | |
for MBQL clauses whose type is the same as the type of the first arg. Also used for [[metabase.lib.schema.expression/type-of]]. | (defmethod type-of-method :lib.type-of/type-is-type-of-first-arg [query stage-number [_tag _opts expr]] (type-of query stage-number expr)) |
(defmethod type-of-method :lib.type-of/type-is-temporal-type-of-first-arg
[query stage-number [_tag _opts expr :as clause]]
(if (string? expr)
;; If a string, get the type filtered by this expression (eg. `:datetime-add`).
(lib.schema.expresssion/type-of clause)
;; Otherwise, just get the type of this first arg.
(type-of query stage-number expr))) | |
Impl for [[metadata]]. Implementations that call [[display-name]] should use the | (defmulti metadata-method
{:arglists '([query stage-number x])}
(fn [_query _stage-number x]
(lib.dispatch/dispatch-value x))
:hierarchy lib.hierarchy/hierarchy) |
(defmethod metadata-method :default
[query stage-number x]
(try
{:lib/type :metadata/column
;; TODO -- effective-type
:base-type (type-of query stage-number x)
:name (column-name query stage-number x)
:display-name (display-name query stage-number x)}
;; if you see this error it's usually because you're calling [[metadata]] on something that you shouldn't be, for
;; example a query
(catch #?(:clj Throwable :cljs js/Error) e
(throw (ex-info (i18n/tru "Error calculating metadata for {0}: {1}"
(pr-str (lib.dispatch/dispatch-value x))
(ex-message e))
{:query query, :stage-number stage-number, :x x}
e))))) | |
(mu/defn metadata :- [:map [:lib/type [:and
:keyword
[:fn
{:error/message ":lib/type should be a :metadata/ keyword"}
#(= (namespace %) "metadata")]]]]
"Calculate an appropriate `:metadata/*` object for something. What this looks like depends on what we're calculating
metadata for. If it's a reference or expression of some sort, this should return a single `:metadata/column`
map (i.e., something satisfying the `::lib.schema.metadata/column` schema."
([query]
(metadata query -1 query))
([query x]
(metadata query -1 x))
([query :- ::lib.schema/query
stage-number :- :int
x]
(metadata-method query stage-number x))) | |
(mu/defn describe-query :- ::lib.schema.common/non-blank-string "Convenience for calling [[display-name]] on a query to describe the results of its final stage." [query] (display-name query query)) | |
(mu/defn suggested-name :- [:maybe ::lib.schema.common/non-blank-string]
"Name you might want to use for a query when saving an previously-unsaved query. This is the same
as [[describe-query]] except for native queries, where we don't describe anything."
[query]
(when-not (= (:lib/type (lib.util/query-stage query -1)) :mbql.stage/native)
(try
(describe-query query)
(catch #?(:clj Throwable :cljs js/Error) e
(log/error e (i18n/tru "Error calculating display name for query: {0}" (ex-message e)))
nil)))) | |
Implementation for [[display-info]]. Implementations that call [[display-name]] should use the Do not call this recursively from its own | (defmulti display-info-method
{:arglists '([query stage-number x])}
(fn [_query _stage-number x]
(lib.dispatch/dispatch-value x))
:hierarchy lib.hierarchy/hierarchy) |
(mr/def ::display-info
[:map
[:display-name {:optional true} :string]
[:long-display-name {:optional true} :string]
;; for things with user specified names
[:named? {:optional true} :boolean]
;; for things that have a Table, e.g. a Field
[:table {:optional true} [:maybe [:ref ::display-info]]]
;; these are derived from the `:lib/source`/`:metabase.lib.schema.metadata/column-source`, but instead of using
;; that value directly we're returning a different property so the FE doesn't break if we change those keys in the
;; future, e.g. if we consolidate or split some of those keys. This is all the FE really needs to know.
;;
;; if this is a Column, does it come from a previous stage?
[:is-from-previous-stage {:optional true} [:maybe :boolean]]
;; if this is a Column, does it come from a join in this stage?
[:is-from-join {:optional true} [:maybe :boolean]]
;; if this is a Column, is it 'calculated', i.e. does it come from an expression in this stage?
[:is-calculated {:optional true} [:maybe :boolean]]
;; if this is a Column, is it an implicitly joinable one? I.e. is it from a different table that we have not
;; already joined, but could implicitly join against?
[:is-implicitly-joinable {:optional true} [:maybe :boolean]]
;; For the `:table` field of a Column, is this the source table, or a joined table?
[:is-source-table {:optional true} [:maybe :boolean]]
;; does this column occur in the breakout clause?
[:is-breakout-column {:optional true} [:maybe :boolean]]
;; does this column occur in the order-by clause?
[:is-order-by-column {:optional true} [:maybe :boolean]]
;; for joins
[:name {:optional true} :string]
;; for aggregation operators
[:column-name {:optional true} :string]
[:description {:optional true} :string]
[:short-name {:optional true} :string]
[:requires-column {:optional true} :boolean]
[:selected {:optional true} :boolean]
;; for binning and bucketing
[:default {:optional true} :boolean]
;; for order by
[:direction {:optional true} [:enum :asc :desc]]]) | |
(mu/defn display-info :- ::display-info
"Given some sort of Cljs object, return a map with the info you'd need to implement UI for it. This is mostly meant to
power the Frontend JavaScript UI; in JS, results will be converted to plain JavaScript objects, so avoid returning
things that should remain opaque."
([query x]
(display-info query -1 x))
([query :- ::lib.schema/query
stage-number :- :int
x]
(lib.cache/side-channel-cache
;; TODO: Caching by stage here is probably unnecessary - it's already a mistake to have an `x` from a different
;; stage than `stage-number`. But it also doesn't hurt much, since a given `x` will only ever have `display-info`
;; called with one `stage-number` anyway.
(keyword "display-info" (str "stage-" stage-number)) x
(fn [x]
(try
(display-info-method query stage-number x)
(catch #?(:clj Throwable :cljs js/Error) e
(throw (ex-info (i18n/tru "Error calculating display info for {0}: {1}"
(lib.dispatch/dispatch-value x)
(ex-message e))
{:query query, :stage-number stage-number, :x x}
e)))))))) | |
Default implementation of [[display-info-method]], available in case you want to use this in a different implementation and add additional information to it. | (defn default-display-info
[query stage-number x]
(let [x-metadata (metadata query stage-number x)]
(merge
;; TODO -- not 100% convinced the FE should actually have access to `:name`, can't it use `:display-name`
;; everywhere? Determine whether or not this is the case.
(select-keys x-metadata [:name :display-name :semantic-type])
(when-let [custom (lib.util/custom-name x)]
{:display-name custom
:named? true})
(when-let [long-display-name (display-name query stage-number x :long)]
{:long-display-name long-display-name})
;; don't return `:base-type`, FE should just use `:effective-type` everywhere and not even need to know
;; `:base-type` exists.
(when-let [effective-type ((some-fn :effective-type :base-type) x-metadata)]
{:effective-type effective-type})
(when-let [table-id (:table-id x-metadata)]
;; TODO: only ColumnMetadatas should possibly have legacy `card__<id>` `:table-id`s... we should
;; probably move this special casing into [[metabase.lib.field]] instead of having it be part of the
;; `:default` method.
(when-let [inner-metadata (cond
(integer? table-id) (lib.metadata/table query table-id)
(string? table-id) (lib.metadata/card
query (lib.util/legacy-string-table-id->card-id table-id)))]
{:table (display-info query stage-number inner-metadata)}))
(when-let [source (:lib/source x-metadata)]
{:is-from-previous-stage (= source :source/previous-stage)
:is-from-join (= source :source/joins)
:is-calculated (= source :source/expressions)
:is-implicitly-joinable (= source :source/implicitly-joinable)
:is-aggregation (= source :source/aggregations)
:is-breakout (= source :source/breakouts)})
(when-some [selected (:selected? x-metadata)]
{:selected selected})
(when-let [temporal-unit ((some-fn :metabase.lib.field/temporal-unit :temporal-unit) x-metadata)]
{:is-temporal-extraction (contains? lib.schema.temporal-bucketing/datetime-extraction-units temporal-unit)})
(select-keys x-metadata [:breakout-position :order-by-position :filter-positions])))) |
(defmethod display-info-method :default [query stage-number x] (default-display-info query stage-number x)) | |
(defmethod display-info-method :metadata/table
[query stage-number table]
(merge (default-display-info query stage-number table)
{:is-source-table (= (lib.util/source-table-id query) (:id table))})) | |
Schema for the column metadata that should be returned by [[metadata]]. | (def ColumnMetadataWithSource
[:merge
[:ref ::lib.schema.metadata/column]
[:map
[:lib/source ::lib.schema.metadata/column-source]]]) |
Schema for column metadata that should be returned by [[visible-columns]]. This is mostly used to power metadata calculation for stages (see [[metabase.lib.stage]]. | (def ColumnsWithUniqueAliases
[:and
[:sequential
[:merge
ColumnMetadataWithSource
[:map
[:lib/source-column-alias ::lib.schema.common/non-blank-string]
[:lib/desired-column-alias [:string {:min 1, :max 60}]]]]]
[:fn
;; should be dev-facing only, so don't need to i18n
{:error/message "Column :lib/desired-column-alias values must be distinct, regardless of case, for each stage!"
:error/fn (fn [{:keys [value]} _]
(str "Column :lib/desired-column-alias values must be distinct, got: "
(pr-str (mapv :lib/desired-column-alias value))))}
(fn [columns]
(or
(empty? columns)
(apply distinct? (map (comp u/lower-case-en :lib/desired-column-alias) columns))))]]) |
(def ^:private UniqueNameFn [:=> [:cat ::lib.schema.common/non-blank-string] ::lib.schema.common/non-blank-string]) | |
Schema for options passed to [[returned-columns]] and [[returned-columns-method]]. | (def ReturnedColumnsOptions
[:map
;; has the signature (f str) => str
[:unique-name-fn {:optional true} UniqueNameFn]]) |
(mu/defn ^:private default-returned-columns-options :- ReturnedColumnsOptions
[]
{:unique-name-fn (lib.util/unique-name-generator)}) | |
Impl for [[returned-columns]]. | (defmulti returned-columns-method
{:arglists '([query stage-number x options])}
(fn [_query _stage-number x _options]
(lib.dispatch/dispatch-value x))
:hierarchy lib.hierarchy/hierarchy) |
(defmethod returned-columns-method :dispatch-type/nil [_query _stage-number _x _options] []) | |
(mu/defn returned-columns :- [:maybe ColumnsWithUniqueAliases]
"Return a sequence of metadata maps for all the columns expected to be 'returned' at a query, stage of the query, or
join, and include the `:lib/source` of where they came from. This should only include columns that will be present
in the results; DOES NOT include 'expected' columns that are not 'exported' to subsequent stages.
See [[ReturnedColumnsOptions]] for allowed options and [[default-returned-columns-options]] for default values."
([query]
(returned-columns query (lib.util/query-stage query -1)))
([query x]
(returned-columns query -1 x))
([query stage-number x]
(returned-columns query stage-number x nil))
([query :- ::lib.schema/query
stage-number :- :int
x
options :- [:maybe ReturnedColumnsOptions]]
(let [options (merge (default-returned-columns-options) options)]
(returned-columns-method query stage-number x options)))) | |
Schema for options passed to [[visible-columns]] and [[visible-columns-method]]. | (def VisibleColumnsOptions
[:merge
ReturnedColumnsOptions
[:map
;; these all default to true
[:include-joined? {:optional true} :boolean]
[:include-expressions? {:optional true} :boolean]
[:include-implicitly-joinable? {:optional true} :boolean]
[:include-implicitly-joinable-for-source-card? {:optional true} :boolean]]]) |
(mu/defn ^:private default-visible-columns-options :- VisibleColumnsOptions
[]
(merge
(default-returned-columns-options)
{:include-joined? true
:include-expressions? true
:include-implicitly-joinable? true
:include-implicitly-joinable-for-source-card? true})) | |
Impl for [[visible-columns]]. This should mostly be similar to the implementation for [[metadata-method]], but needs to include
Also, columns that aren't 'projected' should be returned as well -- in other words, ignore | (defmulti visible-columns-method
{:arglists '([query stage-number x options])}
(fn [_query _stage-number x _options]
(lib.dispatch/dispatch-value x))
:hierarchy lib.hierarchy/hierarchy) |
(defmethod visible-columns-method :dispatch-type/nil [_query _stage-number _x _options] []) | |
default impl is just the impl for [[returned-columns-method]] | (defmethod visible-columns-method :default [query stage-number x options] (returned-columns-method query stage-number x options)) |
(mu/defn visible-columns :- ColumnsWithUniqueAliases
"Return a sequence of columns that should be visible *within* a given stage of something, e.g. a query stage or a
join query. This includes not just the columns that get returned (ones present in [[metadata]], but other columns
that are 'reachable' in this stage of the query. E.g. in a query like
SELECT id, name
FROM table
ORDER BY position
only `id` and `name` are 'returned' columns, but other columns such as `position` are visible in this stage as well
and would thus be returned by this function.
Columns from joins, expressions, and implicitly joinable columns are included automatically by default;
see [[VisibleColumnsOptions]] for the options for disabling these columns."
([query]
(visible-columns query (lib.util/query-stage query -1)))
([query x]
(visible-columns query -1 x))
([query stage-number x]
(visible-columns query stage-number x nil))
([query :- ::lib.schema/query
stage-number :- :int
x
options :- [:maybe VisibleColumnsOptions]]
(let [options (merge (default-visible-columns-options) options)]
(visible-columns-method query stage-number x options)))) | |
(mu/defn primary-keys :- [:sequential ::lib.schema.metadata/column]
"Returns a list of primary keys for the source table of this query."
[query :- ::lib.schema/query]
(if-let [table-id (lib.util/source-table-id query)]
(filter lib.types.isa/primary-key? (lib.metadata/fields query table-id))
[])) | |
Columns that are implicitly joinable from some other columns in Does not include columns from any Tables that are already explicitly joined. Does not include columns that would be implicitly joinable via multiple hops. | (defn implicitly-joinable-columns
[query stage-number column-metadatas unique-name-fn]
(let [existing-table-ids (into #{} (map :table-id) column-metadatas)]
(into []
(comp (filter :fk-target-field-id)
(filter :id)
(filter (comp number? :id))
(map (fn [{source-field-id :id, :keys [fk-target-field-id] :as source}]
(-> (lib.metadata/field query fk-target-field-id)
(assoc ::source-field-id source-field-id
::source-join-alias (:metabase.lib.join/join-alias source)))))
(remove #(contains? existing-table-ids (:table-id %)))
(mapcat (fn [{:keys [table-id], ::keys [source-field-id source-join-alias]}]
(let [table-metadata (lib.metadata/table query table-id)
options {:unique-name-fn unique-name-fn
:include-implicitly-joinable? false}]
(for [field (visible-columns-method query stage-number table-metadata options)
:let [field (assoc field
:fk-field-id source-field-id
:fk-join-alias source-join-alias
:lib/source :source/implicitly-joinable
:lib/source-column-alias (:name field))]]
(assoc field :lib/desired-column-alias (unique-name-fn
(lib.join.util/desired-alias query field))))))))
column-metadatas))) |
(mu/defn default-columns-for-stage :- ColumnsWithUniqueAliases
"Given a query and stage, returns the columns which would be selected by default.
This is exactly [[lib.metadata.calculation/returned-columns]] filtered by the `:lib/source`.
(Fields from explicit joins are listed on the join itself and should not be listed in `:fields`.)
If there is already a `:fields` list on that stage, it is ignored for this calculation."
[query :- ::lib.schema/query
stage-number :- :int]
(let [no-fields (lib.util/update-query-stage query stage-number dissoc :fields)]
(into [] (remove (comp #{:source/joins :source/implicitly-joinable}
:lib/source))
(returned-columns no-fields stage-number (lib.util/query-stage no-fields stage-number))))) | |
(ns metabase.lib.common (:require [metabase.lib.dispatch :as lib.dispatch] [metabase.lib.hierarchy :as lib.hierarchy] [metabase.lib.options :as lib.options] [metabase.lib.ref :as lib.ref] [metabase.lib.schema.common :as schema.common] [metabase.util.malli :as mu]) #?(:cljs (:require-macros [metabase.lib.common]))) | |
(comment lib.options/keep-me
mu/keep-me) | |
(mu/defn external-op :- [:maybe ::schema.common/external-op]
"Convert the internal operator `clause` to the external format."
[[operator options :as clause]]
(when clause
{:lib/type :lib/external-op
:operator (cond-> operator
(keyword? operator) name)
:options options
:args (subvec clause 2)})) | |
Ensures that clause arguments are properly unwrapped | (defmulti ->op-arg
{:arglists '([x])}
lib.dispatch/dispatch-value
:hierarchy lib.hierarchy/hierarchy) |
(defmethod ->op-arg :default
[x]
(if (and (vector? x)
(keyword? (first x)))
;; MBQL clause
(mapv ->op-arg x)
;; Something else - just return it
x)) | |
(defmethod ->op-arg :dispatch-type/sequential [xs] (mapv ->op-arg xs)) | |
(defmethod ->op-arg :metadata/column [field-metadata] (lib.ref/ref field-metadata)) | |
(defmethod ->op-arg :metadata/metric [metric-def] (lib.ref/ref metric-def)) | |
(defmethod ->op-arg :metadata/segment [segment-def] (lib.ref/ref segment-def)) | |
(defmethod ->op-arg :lib/external-op
[{:keys [operator options args] :or {options {}}}]
(->op-arg (lib.options/ensure-uuid (into [(keyword operator) options]
(map ->op-arg)
args)))) | |
Impl for [[defop]]. | (defn defop-create
[op-name args]
(into [op-name {:lib/uuid (str (random-uuid))}]
(map ->op-arg)
args)) |
Defines a clause creating function with given args. Calling the clause without query and stage produces a fn that can be resolved later. | #?(:clj
(defmacro defop
[op-name & argvecs]
{:pre [(symbol? op-name)
(every? vector? argvecs) (every? #(every? symbol? %) argvecs)
(every? #(not-any? #{'query 'stage-number} %) argvecs)]}
`(mu/defn ~op-name :- ~(keyword "mbql.clause" (name op-name))
~(format "Create a standalone clause of type `%s`." (name op-name))
~@(for [argvec argvecs
:let [arglist-expr (if (contains? (set argvec) '&)
(cons `list* (remove #{'&} argvec))
argvec)]]
`([~@argvec]
(defop-create ~(keyword op-name) ~arglist-expr)))))) |
(ns metabase.shared.formatting.constants
#?(:cljs (:require
[metabase.shared.formatting.internal.date-builder :as builder]))) | |
Months and weekdays should be abbreviated for | (defn abbreviated?
[{:keys [output-density]}]
(= output-density "compact")) |
For | (defn condense-ranges?
[{:keys [output-density]}]
(#{"compact" "condensed"} output-density)) |
The default date style, used in a few places in the JS code as well as by this formatting library. | (def ^:export default-date-style "MMMM D, YYYY") |
The default time style, used in a few places in the JS code as well as by this formatting library. | (def ^:export default-time-style "h:mm A") |
A map of string patterns for dates, to functions from options to the data structures consumed by [[metabase.shared.formatting.internal.date-builder]]. Prefer passing the data structure directly, or use | (def ^:export known-date-styles
{"M/D/YYYY" [:month-d "/" :day-of-month-d "/" :year]
"D/M/YYYY" [:day-of-month-d "/" :month-d "/" :year]
"YYYY/M/D" [:year "/" :month-d "/" :day-of-month-d]
"MMMM D, YYYY" [:month-full " " :day-of-month-d ", " :year]
"D MMMM, YYYY" [:day-of-month-d " " :month-full ", " :year]
"dddd, MMMM D, YYYY" [:day-of-week-full ", " :month-full " " :day-of-month-d ", " :year]}) |
A table of string patterns for dates to the data structures consumed by [[metabase.shared.formatting.internal.date-builder]]. Don't rely on these - prefer passing the data structure directly, or use | (def ^:export known-time-styles
{"h:mm A" [:hour-12-d ":" :minute-dd " " :am-pm]
"HH:mm" [:hour-24-dd ":" :minute-dd]
"HH" [:hour-24-dd]}) |
A table of string patterns for datetimes to the data structures consumed by [[metabase.shared.formatting.internal.date-builder]]. Don't rely on these - prefer passing the data structure directly, or use | (def ^:export known-datetime-styles
{"M/D/YYYY, h:mm A" {:date-format (get known-date-styles "M/D/YYYY")
:time-format (get known-time-styles "h:mm A")}}) |
Ported from frontend/src/metabase-lib/types/constants.js | (ns metabase.lib.types.constants #?(:cljs (:require [goog.object :as gobj]))) |
A front-end specific type hierarchy used by [[metabase.lib.types.isa/field-type?]]. It is not meant to be used directly. | #?(:cljs
(do
(def ^:export name->type
"A map of Type name (as string, without `:type/` namespace) -> type keyword
{\"Temporal\" :type/Temporal, ...}"
(reduce (fn [m typ] (doto m (gobj/set (name typ) typ)))
#js {}
(distinct (mapcat descendants [:type/* :Semantic/* :Relation/*]))))
;; primary field types used for picking operators, etc
(def ^:export key-number "JS-friendly access for the number type" ::number)
(def ^:export key-string "JS-friendly access for the string type" ::string)
(def ^:export key-string-like "JS-friendly access for the string-like type" ::string-like)
(def ^:export key-boolean "JS-friendly access for the boolean type" ::boolean)
(def ^:export key-temporal "JS-friendly access for the temporal type" ::temporal)
(def ^:export key-location "JS-friendly access for the location type" ::location)
(def ^:export key-coordinate "JS-friendly access for the coordinate type" ::coordinate)
(def ^:export key-foreign-KEY "JS-friendly access for the foreign-key type" ::foreign-key)
(def ^:export key-primary-KEY "JS-friendly access for the primary-key type" ::primary-key)
(def ^:export key-json "JS-friendly access for the JSON type" ::json)
(def ^:export key-xml "JS-friendly access for the JSON type" ::xml)
(def ^:export key-structured "JS-friendly access for the structured type" ::structured)
;; other types used for various purposes
(def ^:export key-summable "JS-friendly access for the summable type" ::summable)
(def ^:export key-scope "JS-friendly access for the scope type" ::scope)
(def ^:export key-category "JS-friendly access for the category type" ::category)
(def ^:export key-unknown "JS-friendly access for the unknown type" ::unknown)))
;; NOTE: be sure not to create cycles using the "other" types
(def type-hierarchies
{::temporal {:effective-type [:type/Temporal]
:semantic-type [:type/Temporal]}
::number {:effective-type [:type/Number]
:semantic-type [:type/Number]}
::integer {:effective-type [:type/Integer]}
::string {:effective-type [:type/Text]
:semantic-type [:type/Text :type/Category]}
::string_like {:effective-type [:type/TextLike]}
::boolean {:effective-type [:type/Boolean]}
::coordinate {:semantic-type [:type/Coordinate]}
::location {:semantic-type [:type/Address]}
::entity {:semantic-type [:type/FK :type/PK :type/Name]}
::foreign_key {:semantic-type [:type/FK]}
::primary_key {:semantic-type [:type/PK]}
::json {:effective-type [:type/SerializedJSON]}
::xml {:effective-type [:type/XML]}
::structured {:effective-type [:type/Structured]}
::summable {:include [::number]
:exclude [::entity ::location ::temporal]}
::scope {:include [::number ::temporal ::category ::entity ::string]
:exclude [::location]}
::category {:effective-type [:type/Boolean]
:semantic-type [:type/Category]
:include [::location]}
;; NOTE: this is defunct right now. see definition of metabase.lib.types.isa/dimension?.
::dimension {:include [::temporal ::category ::entity]}}) |
(ns metabase.lib.convert (:require [clojure.data :as data] [clojure.set :as set] [clojure.string :as str] [malli.core :as mc] [malli.error :as me] [medley.core :as m] [metabase.lib.dispatch :as lib.dispatch] [metabase.lib.hierarchy :as lib.hierarchy] [metabase.lib.options :as lib.options] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.expression :as lib.schema.expression] [metabase.lib.schema.ref :as lib.schema.ref] [metabase.lib.util :as lib.util] [metabase.mbql.normalize :as mbql.normalize] [metabase.util :as u] [metabase.util.log :as log] [metabase.util.malli :as mu]) #?@(:cljs [(:require-macros [metabase.lib.convert :refer [with-aggregation-list]])])) | |
(def ^:private ^:dynamic *pMBQL-uuid->legacy-index*
{}) | |
(def ^:private ^:dynamic *legacy-index->pMBQL-uuid*
{}) | |
(defn- clean-location [almost-stage error-type error-location]
(let [operate-on-parent? #{:malli.core/missing-key :malli.core/end-of-input}
location (if (operate-on-parent? error-type)
(drop-last 2 error-location)
(drop-last 1 error-location))
[location-key] (if (operate-on-parent? error-type)
(take-last 2 error-location)
(take-last 1 error-location))]
(if (seq location)
(update-in almost-stage
location
(fn [error-loc]
(let [result (assoc error-loc location-key nil)]
(cond
(vector? error-loc) (into [] (remove nil?) result)
(map? error-loc) (u/remove-nils result)
:else result))))
(dissoc almost-stage location-key)))) | |
(def ^:private stage-keys
#{:aggregation :breakout :expressions :fields :filters :order-by :joins}) | |
(defn- clean-stage-schema-errors [almost-stage]
(loop [almost-stage almost-stage
removals []]
(if-let [[error-type error-location] (->> (mc/explain ::lib.schema/stage.mbql almost-stage)
:errors
(filter (comp stage-keys first :in))
(map (juxt :type :in))
first)]
(let [new-stage (clean-location almost-stage error-type error-location)]
(log/warnf "Clean: Removing bad clause in %s due to error %s:\n%s"
(u/colorize :yellow (pr-str error-location))
(u/colorize :yellow (pr-str (or error-type
;; if `error-type` is missing, which seems to happen sometimes,
;; fall back to humanizing the entire error.
(me/humanize (mc/explain ::lib.schema/stage.mbql almost-stage)))))
(u/colorize :red (u/pprint-to-str (first (data/diff almost-stage new-stage)))))
(if (= new-stage almost-stage)
almost-stage
(recur new-stage (conj removals [error-type error-location]))))
almost-stage))) | |
(defn- clean-stage-ref-errors [almost-stage]
(reduce (fn [almost-stage [loc _]]
(clean-location almost-stage ::lib.schema/invalid-ref loc))
almost-stage
(lib.schema/ref-errors-for-stage almost-stage))) | |
(defn- clean-stage [almost-stage]
(-> almost-stage
clean-stage-schema-errors
clean-stage-ref-errors)) | |
(defn- clean [almost-query]
(loop [almost-query almost-query
stage-index 0]
(let [current-stage (nth (:stages almost-query) stage-index)
new-stage (clean-stage current-stage)]
(if (= current-stage new-stage)
(if (= stage-index (dec (count (:stages almost-query))))
almost-query
(recur almost-query (inc stage-index)))
(recur (update almost-query :stages assoc stage-index new-stage) stage-index))))) | |
Coerce something to pMBQL (the version of MBQL manipulated by Metabase Lib v2) if it's not already pMBQL. | (defmulti ->pMBQL
{:arglists '([x])}
lib.dispatch/dispatch-value
:hierarchy lib.hierarchy/hierarchy) |
(defn- default-MBQL-clause->pMBQL [mbql-clause]
(let [last-elem (peek mbql-clause)
last-elem-option? (map? last-elem)
[clause-type & args] (cond-> mbql-clause
last-elem-option? pop)
options (if last-elem-option?
last-elem
{})]
(lib.options/ensure-uuid (into [clause-type options] (map ->pMBQL) args)))) | |
(defmethod ->pMBQL :default
[x]
(if (and (vector? x)
(keyword? (first x)))
(default-MBQL-clause->pMBQL x)
x)) | |
(defmethod ->pMBQL :mbql/query [query] query) | |
In legacy MBQL, join Since the new pMBQL schema makes | (def legacy-default-join-alias "__join") |
Join Only deduplicate the default | (defn- deduplicate-join-aliases
[joins]
(let [unique-name-fn (lib.util/unique-name-generator)]
(mapv (fn [join]
(cond-> join
(= (:alias join) legacy-default-join-alias) (update :alias unique-name-fn)))
joins))) |
If a query | (defn- stage-source-card-id->pMBQL
[stage]
(if (string? (:source-table stage))
(-> stage
(assoc :source-card (lib.util/legacy-string-table-id->card-id (:source-table stage)))
(dissoc :source-table))
stage)) |
Macro for capturing the context of a query stage's | #?(:clj
(defmacro with-aggregation-list
[aggregations & body]
`(let [aggregations# ~aggregations
legacy->pMBQL# (into {}
(map-indexed (fn [~'idx [~'_tag {~'ag-uuid :lib/uuid}]]
[~'idx ~'ag-uuid]))
aggregations#)
pMBQL->legacy# (into {}
(map-indexed (fn [~'idx [~'_tag {~'ag-uuid :lib/uuid}]]
[~'ag-uuid ~'idx]))
aggregations#)]
(binding [*legacy-index->pMBQL-uuid* legacy->pMBQL#
*pMBQL-uuid->legacy-index* pMBQL->legacy#]
~@body)))) |
(defmethod ->pMBQL :mbql.stage/mbql
[stage]
(let [aggregations (->pMBQL (:aggregation stage))
expressions (->> stage
:expressions
(mapv (fn [[k v]]
(-> v
->pMBQL
(lib.util/top-level-expression-clause k))))
not-empty)]
(metabase.lib.convert/with-aggregation-list aggregations
(let [stage (-> stage
stage-source-card-id->pMBQL
(m/assoc-some :aggregation aggregations :expressions expressions))
stage (reduce
(fn [stage k]
(if-not (get stage k)
stage
(update stage k ->pMBQL)))
stage
(disj stage-keys :aggregation :expressions))]
(cond-> stage
(:joins stage) (update :joins deduplicate-join-aliases)))))) | |
(defmethod ->pMBQL :mbql.stage/native [stage] (m/update-existing stage :template-tags update-vals (fn [tag] (m/update-existing tag :dimension ->pMBQL)))) | |
(defmethod ->pMBQL :mbql/join
[join]
(let [join (-> join
(update :conditions ->pMBQL)
(update :stages ->pMBQL))]
(cond-> join
(:fields join) (update :fields (fn [fields]
(if (seqable? fields)
(mapv ->pMBQL fields)
(keyword fields))))
(not (:alias join)) (assoc :alias legacy-default-join-alias)))) | |
(defmethod ->pMBQL :dispatch-type/sequential [xs] (mapv ->pMBQL xs)) | |
(defmethod ->pMBQL :dispatch-type/map
[m]
(if (:type m)
(-> (lib.util/pipeline m)
(update :stages (fn [stages]
(mapv ->pMBQL stages)))
(assoc :lib.convert/converted? true)
clean)
(update-vals m ->pMBQL))) | |
(defmethod ->pMBQL :field
[[_tag x y]]
(let [[id-or-name options] (if (map? x)
[y x]
[x y])]
(lib.options/ensure-uuid [:field options id-or-name]))) | |
(defmethod ->pMBQL :value
[[_tag value opts]]
;; `:value` uses `:snake_case` keys in legacy MBQL for some insane reason (actually this was to match the shape of
;; the keys in Field metadata), at least for the three type keys enumerated below.
;; See [[metabase.mbql.schema/ValueTypeInfo]].
(let [opts (set/rename-keys opts {:base_type :base-type
:semantic_type :semantic-type
:database_type :database-type})
;; in pMBQL, `:effective-type` is a required key for `:value`. `:value` SHOULD have always had `:base-type`,
;; but on the off chance it did not, get the type from value so the schema doesn't fail entirely.
opts (assoc opts :effective-type (or (:effective-type opts)
(:base-type opts)
(lib.schema.expression/type-of value)))]
(lib.options/ensure-uuid [:value opts value]))) | |
(defmethod ->pMBQL :case
[[_tag pred-expr-pairs options]]
(let [default (:default options)]
(cond-> [:case (dissoc options :default) (mapv ->pMBQL pred-expr-pairs)]
:always lib.options/ensure-uuid
(some? default) (conj (->pMBQL default))))) | |
(defmethod ->pMBQL :expression [[tag value opts]] (lib.options/ensure-uuid [tag opts value])) | |
(defn- get-or-throw!
[m k]
(let [result (get m k ::not-found)]
(if-not (= result ::not-found)
result
(throw (ex-info (str "Unable to find key " (pr-str k) " in map.")
{:m m
:k k}))))) | |
(defmethod ->pMBQL :aggregation
[[tag aggregation-index opts, :as clause]]
(lib.options/ensure-uuid
[tag opts (or (get *legacy-index->pMBQL-uuid* aggregation-index)
(throw (ex-info (str "Error converting :aggregation reference: no aggregation at index "
aggregation-index)
{:clause clause})))])) | |
(defmethod ->pMBQL :aggregation-options
[[_tag aggregation options]]
(let [[tag opts & args] (->pMBQL aggregation)]
(into [tag (merge opts options)] args))) | |
Convert a legacy 'inner query' to a full legacy 'outer query' so you can pass it to stuff like [[metabase.mbql.normalize/normalize]], and then probably to [[->pMBQL]]. | (defn legacy-query-from-inner-query
[database-id inner-query]
(merge {:database database-id, :type :query}
(if (:native inner-query)
{:native (set/rename-keys inner-query {:native :query})}
{:query inner-query}))) |
Coerce something to legacy MBQL (the version of MBQL understood by the query processor and Metabase Lib v1) if it's not already legacy MBQL. | (defmulti ->legacy-MBQL
{:arglists '([x])}
lib.dispatch/dispatch-value
:hierarchy lib.hierarchy/hierarchy) |
Does keyword | (defn- metabase-lib-keyword?
[k]
(and (qualified-keyword? k)
(when-let [symb-namespace (namespace k)]
(or (= symb-namespace "lib")
(str/starts-with? symb-namespace "metabase.lib."))))) |
Remove any keys starting with the No args = return transducer to remove keys from a map. One arg = update a map | (defn- disqualify
([]
(remove (fn [[k _v]]
(metabase-lib-keyword? k))))
([m]
(into {} (disqualify) m))) |
Convert an options map in an MBQL clause to the equivalent shape for legacy MBQL. Remove | (defn- options->legacy-MBQL
[m]
(not-empty
(into {}
(comp (disqualify)
(remove (fn [[k _v]]
(= k :effective-type))))
m))) |
(defn- aggregation->legacy-MBQL [[tag options & args]]
(let [inner (into [tag] (map ->legacy-MBQL) args)
;; the default value of the :case expression is in the options
;; in legacy MBQL
inner (if (and (= tag :case) (next args))
(conj (pop inner) {:default (peek inner)})
inner)]
(if-let [aggregation-opts (not-empty (options->legacy-MBQL options))]
[:aggregation-options inner aggregation-opts]
inner))) | |
(defn- clause-with-options->legacy-MBQL [[k options & args]]
(if (map? options)
(into [k] (concat (map ->legacy-MBQL args)
(when-let [options (options->legacy-MBQL options)]
[options])))
(into [k] (map ->legacy-MBQL (cons options args))))) | |
(defmethod ->legacy-MBQL :default
[x]
(cond
(and (vector? x)
(keyword? (first x))) (clause-with-options->legacy-MBQL x)
(map? x) (-> x
disqualify
(update-vals ->legacy-MBQL))
:else x)) | |
(doseq [tag [::aggregation ::expression]] (lib.hierarchy/derive tag ::aggregation-or-expression)) | |
(doseq [tag [:count :avg :count-where :distinct
:max :median :min :percentile
:share :stddev :sum :sum-where]]
(lib.hierarchy/derive tag ::aggregation)) | |
(doseq [tag [:+ :- :* :/
:case :coalesce
:abs :log :exp :sqrt :ceil :floor :round :power :interval
:relative-datetime :time :absolute-datetime :now :convert-timezone
:get-week :get-year :get-month :get-day :get-hour
:get-minute :get-second :get-quarter
:datetime-add :datetime-subtract
:concat :substring :replace :regexextract :regex-match-first
:length :trim :ltrim :rtrim :upper :lower]]
(lib.hierarchy/derive tag ::expression)) | |
(defmethod ->legacy-MBQL ::aggregation-or-expression [input] (aggregation->legacy-MBQL input)) | |
(defn- stage-metadata->legacy-metadata [stage-metadata]
(into []
(comp (map #(update-keys % u/->snake_case_en))
(map ->legacy-MBQL))
(:columns stage-metadata))) | |
(defn- chain-stages [{:keys [stages]}]
;; :source-metadata aka :lib/stage-metadata is handled differently in the two formats.
;; In legacy, an inner query might have both :source-query, and :source-metadata giving the metadata for that nested
;; :source-query.
;; In pMBQL, the :lib/stage-metadata is attached to the same stage it applies to.
;; So when chaining pMBQL stages back into legacy form, if stage n has :lib/stage-metadata, stage n+1 needs
;; :source-metadata attached.
(let [inner-query (first (reduce (fn [[inner stage-metadata] stage]
[(cond-> (->legacy-MBQL stage)
inner (assoc :source-query inner)
stage-metadata (assoc :source-metadata (stage-metadata->legacy-metadata stage-metadata)))
;; Get the :lib/stage-metadata off the original pMBQL stage, not the converted one.
(:lib/stage-metadata stage)])
nil
stages))]
(cond-> inner-query
;; If this is a native query, inner query will be used like: `{:type :native :native #_inner-query {:query ...}}`
(:native inner-query) (set/rename-keys {:native :query})))) | |
(defmethod ->legacy-MBQL :dispatch-type/map [m]
(into {}
(comp (disqualify)
(map (fn [[k v]]
[k (->legacy-MBQL v)])))
m)) | |
(defmethod ->legacy-MBQL :aggregation [[_ opts agg-uuid :as ag]]
(if (map? opts)
(try
(let [opts (options->legacy-MBQL opts)]
(cond-> [:aggregation (get-or-throw! *pMBQL-uuid->legacy-index* agg-uuid)]
opts (conj opts)))
(catch #?(:clj Throwable :cljs :default) e
(throw (ex-info (lib.util/format "Error converting aggregation reference to pMBQL: %s" (ex-message e))
{:ref ag}
e))))
;; Our conversion is a bit too aggressive and we're hitting legacy refs like [:aggregation 0] inside source_metadata that are only used for legacy and thus can be ignored
ag)) | |
(defmethod ->legacy-MBQL :dispatch-type/sequential [xs] (mapv ->legacy-MBQL xs)) | |
(defmethod ->legacy-MBQL :field [[_ opts id]]
;; Fields are not like the normal clauses - they need that options field even if it's null.
;; TODO: Sometimes the given field is in the legacy order - that seems wrong.
(let [[opts id] (if (or (nil? opts) (map? opts))
[opts id]
[id opts])]
[:field
(->legacy-MBQL id)
(options->legacy-MBQL opts)])) | |
(defmethod ->legacy-MBQL :value
[[_tag opts value]]
(let [opts (-> opts
;; as mentioned above, `:value` in legacy MBQL expects `snake_case` keys for type info keys.
(set/rename-keys {:base-type :base_type
:semantic-type :semantic_type
:database-type :database_type})
options->legacy-MBQL)]
;; in legacy MBQL, `:value` has to be three args; `opts` has to be present, but it should can be `nil` if it is
;; empty.
[:value value opts])) | |
(defn- update-list->legacy-boolean-expression
[m pMBQL-key legacy-key]
(cond-> m
(= (count (get m pMBQL-key)) 1) (m/update-existing pMBQL-key (comp ->legacy-MBQL first))
(> (count (get m pMBQL-key)) 1) (m/update-existing pMBQL-key #(into [:and] (map ->legacy-MBQL) %))
:always (set/rename-keys {pMBQL-key legacy-key}))) | |
(defmethod ->legacy-MBQL :mbql/join [join]
(let [base (cond-> (disqualify join)
(str/starts-with? (:alias join) legacy-default-join-alias) (dissoc :alias))]
(merge (-> base
(dissoc :stages :conditions)
(update-vals ->legacy-MBQL))
(-> base
(select-keys [:conditions])
(update-list->legacy-boolean-expression :conditions :condition))
(chain-stages base)))) | |
If a pMBQL query stage has | (defn- source-card->legacy-source-table
[stage]
(if-let [source-card-id (:source-card stage)]
(-> stage
(dissoc :source-card)
(assoc :source-table (str "card__" source-card-id)))
stage)) |
(defmethod ->legacy-MBQL :mbql.stage/mbql
[stage]
(metabase.lib.convert/with-aggregation-list (:aggregation stage)
(reduce #(m/update-existing %1 %2 ->legacy-MBQL)
(-> stage
disqualify
source-card->legacy-source-table
(m/update-existing :aggregation #(mapv aggregation->legacy-MBQL %))
(m/update-existing :expressions (fn [expressions]
(into {}
(for [expression expressions
:let [legacy-clause (->legacy-MBQL expression)]]
[(lib.util/expression-name expression)
;; We wrap literals in :value ->pMBQL
;; so unwrap this direction
(if (= :value (first legacy-clause))
(second legacy-clause)
legacy-clause)]))))
(update-list->legacy-boolean-expression :filters :filter))
(disj stage-keys :aggregation :filters :expressions)))) | |
(defmethod ->legacy-MBQL :mbql.stage/native [stage]
(-> stage
disqualify
(update-vals ->legacy-MBQL))) | |
(defmethod ->legacy-MBQL :mbql/query [query]
(try
(let [base (disqualify query)
parameters (:parameters base)
inner-query (chain-stages base)
query-type (if (-> query :stages last :lib/type (= :mbql.stage/native))
:native
:query)]
(merge (-> base
(dissoc :stages :parameters :lib.convert/converted?)
(update-vals ->legacy-MBQL))
(cond-> {:type query-type query-type inner-query}
(seq parameters) (assoc :parameters parameters))))
(catch #?(:clj Throwable :cljs :default) e
(throw (ex-info (lib.util/format "Error converting MLv2 query to legacy query: %s" (ex-message e))
{:query query}
e))))) | |
TODO: Look into whether this function can be refactored away - it's called from several places but I (Braden) think
legacy refs shouldn't make it out of | (mu/defn legacy-ref->pMBQL :- ::lib.schema.ref/ref
"Convert a legacy MBQL `:field`/`:aggregation`/`:expression` reference to pMBQL. Normalizes the reference if needed,
and handles JS -> Clj conversion as needed."
([query legacy-ref]
(legacy-ref->pMBQL query -1 legacy-ref))
([query :- ::lib.schema/query
stage-number :- :int
legacy-ref :- some?]
(let [legacy-ref (->> #?(:clj legacy-ref :cljs (js->clj legacy-ref :keywordize-keys true))
(mbql.normalize/normalize-fragment nil))
{aggregations :aggregation} (lib.util/query-stage query stage-number)]
(with-aggregation-list aggregations
(try
(->pMBQL legacy-ref)
(catch #?(:clj Throwable :cljs :default) e
(throw (ex-info (lib.util/format "Error converting legacy ref to pMBQL: %s" (ex-message e))
{:query query
:stage-number stage-number
:legacy-ref legacy-ref
:legacy-index->pMBQL-uuid *legacy-index->pMBQL-uuid*}
e)))))))) |
(defn- from-json [query-fragment]
#?(:cljs (if (object? query-fragment)
(js->clj query-fragment :keywordize-keys true)
query-fragment)
:clj query-fragment)) | |
Given a JSON-formatted legacy MBQL query, transform it to pMBQL. If you have only the inner query map ( | (defn js-legacy-query->pMBQL
[query-map]
(-> query-map
from-json
(u/assoc-default :type :query)
mbql.normalize/normalize
->pMBQL)) |
Given a JSON-formatted inner query, transform it to pMBQL. If you have a complete legacy query ( | (defn js-legacy-inner-query->pMBQL
[inner-query]
(js-legacy-query->pMBQL {:type :query
:query (from-json inner-query)})) |
The formatting strings are not standardized. Rather than wrangling with strings, this library defines a data structure for describing the format of date/time strings. A format is represented as a (JS or CLJS) list of keyword or string date fragments ( Examples:
- | (ns metabase.shared.formatting.internal.date-builder
(:require
[clojure.string :as str])
#?(:clj (:import
java.time.format.DateTimeFormatter))) |
This is the complete set of keys the formats can contain, mapped to the platform-specific magic string expected by Moment.js or java.time.format.DateTimeFormatter. Many are the same, but not all. | (def format-strings
{:year #?(:cljs "YYYY" :clj "yyyy") ; 2022
:quarter "Q" ; 2 ("Q2" etc. is added by higher level formatting)
:month-full "MMMM" ; April
:month-short "MMM" ; Apr
:month-dd "MM" ; 04
:month-d "M" ; 4
:day-of-month-d #?(:cljs "D" :clj "d") ; 6
:day-of-month-dd #?(:cljs "DD" :clj "dd") ; 06
:day-of-week-full #?(:cljs "dddd" :clj "EEEE") ; Friday
:day-of-week-short #?(:cljs "ddd" :clj "EEE") ; Fri
:hour-24-dd "HH" ; 17, 05
:hour-24-d "H" ; 17, 5
:hour-12-dd "hh" ; 05
:hour-12-d "h" ; 5
:am-pm #?(:cljs "A" :clj "a") ; AM
:minute-d "m" ; 7, 39
:minute-dd "mm" ; 07, 39
:second-dd "ss" ; 08, 45
:millisecond-ddd "SSS" ; 001, 423
:day-of-year #?(:cljs "DDD" :clj "D") ; 235
:week-of-year #?(:cljs "wo" :clj "w")}) ; 34th in CLJS, 34 in CLJ. No ordinal numbers in Java. |
(defn- format-string-literal [lit]
#?(:cljs (str "[" lit "]")
:clj (str "'" (str/replace lit "'" "''") "'"))) | |
Given a data structure describing the date format, as given in [[format-strings]], return a function that takes a date object and formats it. | (defn ->formatter
[format-list]
(let [js->clj #?(:cljs js->clj :clj identity)
parts (for [fmt (js->clj format-list)]
(cond
(keyword? fmt) (get format-strings fmt)
(= fmt ":") (format-string-literal ":")
(str/starts-with? fmt ":") (-> fmt (subs 1) keyword format-strings)
(string? fmt) (format-string-literal fmt)
:else (throw (ex-info "Unknown element of date format"
{:bad-element fmt
:format format-list}))))
fmt-str (apply str parts)]
#?(:cljs #(.format % fmt-str)
:clj (let [formatter (DateTimeFormatter/ofPattern fmt-str)]
#(.format formatter %))))) |
Preload magic to load cljs-devtools. Only imported by dev.js in dev mode; no-op in production. | (ns metabase.util.devtools
;; This special context is defined only for dev-mode shadow-cljs builds; see shadow-cljs.edn
;; In release builds, and JVM Clojure, this file is an empty namespace.
#?(:cljs-dev (:require
[devtools.core :as devtools]
[shadow.cljs.devtools.client.browser]))) |
Logic for determining whether two pMBQL queries are equal. | (ns metabase.lib.equality (:refer-clojure :exclude [=]) (:require [medley.core :as m] [metabase.lib.card :as lib.card] [metabase.lib.convert :as lib.convert] [metabase.lib.dispatch :as lib.dispatch] [metabase.lib.hierarchy :as lib.hierarchy] [metabase.lib.metadata :as lib.metadata] [metabase.lib.options :as lib.options] [metabase.lib.ref :as lib.ref] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.id :as lib.schema.id] [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.lib.schema.ref :as lib.schema.ref] [metabase.lib.util :as lib.util] [metabase.util.malli :as mu] #?@(:clj ([metabase.util.log :as log])))) |
Determine whether two already-normalized pMBQL maps, clauses, or other sorts of expressions are equal. The basic rule
is that two things are considered equal if they are [[clojure.core/=]], or, if they are both maps, if they
are [[clojure.core/=]] if you ignore all qualified keyword keys besides | (defmulti =
{:arglists '([x y])}
;; two things with different dispatch values (for maps, the `:lib/type` key; for MBQL clauses, the tag, and for
;; everything else, the `:dispatch-type/*` key) can't be equal.
(fn [x y]
(let [x-dispatch-value (lib.dispatch/dispatch-value x)
y-dispatch-value (lib.dispatch/dispatch-value y)]
(if (not= x-dispatch-value y-dispatch-value)
::different-dispatch-values
x-dispatch-value)))
:hierarchy lib.hierarchy/hierarchy) |
(defmethod = ::different-dispatch-values [_x _y] false) | |
Set of keys in a map that we consider relevant for [[=]] purposes. | (defn- relevant-keys-set
[m]
(into #{}
(remove (fn [k]
(and (qualified-keyword? k)
(not= k :lib/type))))
(keys m))) |
(defmethod = :dispatch-type/map
[m1 m2]
(let [m1-keys (relevant-keys-set m1)
m2-keys (relevant-keys-set m2)]
(and (clojure.core/= m1-keys m2-keys)
(every? (fn [k]
(= (get m1 k)
(get m2 k)))
m1-keys)))) | |
(defmethod = :dispatch-type/sequential
[xs ys]
(and (clojure.core/= (count xs) (count ys))
(loop [[x & more-x] xs, [y & more-y] ys]
(and (= x y)
(or (empty? more-x)
(recur more-x more-y)))))) | |
(def ^:private ^:dynamic *side->uuid->index* nil) | |
(defn- aggregation-uuid->index
[stage]
(into {}
(map-indexed (fn [idx [_tag {ag-uuid :lib/uuid}]]
[ag-uuid idx]))
(:aggregation stage))) | |
(defmethod = :mbql.stage/mbql
[x y]
(binding [*side->uuid->index* {:left (aggregation-uuid->index x)
:right (aggregation-uuid->index y)}]
((get-method = :dispatch-type/map) x y))) | |
(defmethod = :aggregation
[[x-tag x-opts x-uuid :as x] [y-tag y-opts y-uuid :as y]]
(and (clojure.core/= 3 (count x) (count y))
(clojure.core/= x-tag y-tag)
(= x-opts y-opts)
;; If nil, it means we aren't comparing a stage, so just compare the uuid directly
(if *side->uuid->index*
(clojure.core/= (get-in *side->uuid->index* [:left x-uuid] ::no-left)
(get-in *side->uuid->index* [:right y-uuid] ::no-right))
(clojure.core/= x-uuid y-uuid)))) | |
if we've gotten here we at least know the dispatch values for | (defmethod = :default
[x y]
(cond
(map? x) ((get-method = :dispatch-type/map) x y)
(sequential? x) ((get-method = :dispatch-type/sequential) x y)
:else (clojure.core/= x y))) |
(mu/defn resolve-field-id :- ::lib.schema.metadata/column
"Integer Field ID: get metadata from the metadata provider. If this is the first stage of the query, merge in
Saved Question metadata if available.
This doesn't really have a good home. It's used here and by [[metabase.lib.field]], but because it depends on eg.
[[metabase.lib.card]] and [[metabase.lib.convert]] it can't go in [[metabase.lib.metadata.calculation]]."
[query :- ::lib.schema/query
stage-number :- :int
field-id :- ::lib.schema.id/field]
(merge
(when (lib.util/first-stage? query stage-number)
(when-let [card-id (lib.util/source-card-id query)]
(when-let [card-metadata (lib.card/saved-question-metadata query card-id)]
(m/find-first #(clojure.core/= (:id %) field-id)
card-metadata))))
(try
(lib.metadata/field query field-id)
(catch #?(:clj Throwable :cljs :default) _
nil)))) | |
(mu/defn ^:private column-join-alias :- [:maybe :string] [column :- ::lib.schema.metadata/column] ((some-fn :metabase.lib.join/join-alias :source-alias) column)) | |
(mu/defn ^:private matching-join? :- :boolean
[[_ref-kind {:keys [join-alias source-field]} _ref-id] :- ::lib.schema.ref/ref
column :- ::lib.schema.metadata/column]
;; If the ref has a source-field, and it matches the column's :fk-field-id then this is an implicitly joined field.
;; Implicitly joined columns have :source-alias ("PRODUCTS__via__PRODUCT_ID") but the refs don't have any join alias.
(or (and source-field
(clojure.core/= source-field (:fk-field-id column)))
;; If it's not an implicit join, then either the join aliases must match for an explicit join, or both be nil for
;; an own column.
(clojure.core/= (column-join-alias column) join-alias))) | |
(mu/defn ^:private plausible-matches-for-name :- [:sequential ::lib.schema.metadata/column]
[[_ref-kind _opts ref-name :as a-ref] :- ::lib.schema.ref/ref
columns :- [:sequential ::lib.schema.metadata/column]]
(or (not-empty (filter #(and (clojure.core/= (:lib/desired-column-alias %) ref-name)
(matching-join? a-ref %))
columns))
(filter #(and (clojure.core/= (:name %) ref-name)
(matching-join? a-ref %))
columns))) | |
(mu/defn ^:private plausible-matches-for-id :- [:sequential ::lib.schema.metadata/column]
[[_ref-kind opts ref-id :as a-ref] :- ::lib.schema.ref/ref
columns :- [:sequential ::lib.schema.metadata/column]
generous? :- [:maybe :boolean]]
(or (not-empty (filter #(and (clojure.core/= (:id %) ref-id)
;; TODO: If the target ref has no join-alias, AND the source is fields or card, the join
;; alias on the column can be ignored. QP can set it when it shouldn't. See #33972.
(or (and (not (:join-alias opts))
(#{:source/fields :source/card} (:lib/source %)))
(matching-join? a-ref %)))
columns))
(when generous?
(not-empty (filter #(clojure.core/= (:id %) ref-id) columns)))
[])) | |
(defn- ambiguous-match-error [a-ref columns]
(ex-info "Ambiguous match! Implement more logic in disambiguate-matches."
{:ref a-ref
:columns columns})) | |
(mu/defn ^:private expression-column? [column]
(or (= (:lib/source column) :source/expressions)
(:lib/expression-name column))) | |
(mu/defn ^:private disambiguate-matches-dislike-field-refs-to-expressions :- [:maybe ::lib.schema.metadata/column]
"If a custom column is a simple wrapper for a field, that column gets `:id`, `:table_id`, etc.
A custom column should get a ref like `[:expression {} \"expr name\"]`, not `[:field {} 17]`.
If we got a `:field` ref, prefer matches which are not `:lib/source :source/expressions`."
[a-ref :- ::lib.schema.ref/ref
columns :- [:sequential ::lib.schema.metadata/column]]
(or (when (= (first a-ref) :field)
(when-let [non-exprs (not-empty (remove expression-column? columns))]
(when-not (next non-exprs)
(first non-exprs))))
;; In all other cases, this is an ambiguous match.
#_(throw (ambiguous-match-error a-ref columns))
#?(:cljs (js/console.warn (ambiguous-match-error a-ref columns))
:clj (log/warn (ambiguous-match-error a-ref columns))))) | |
(mu/defn ^:private disambiguate-matches-prefer-explicit :- [:maybe ::lib.schema.metadata/column]
"Prefers table-default or explicitly joined columns over implicitly joinable ones."
[a-ref :- ::lib.schema.ref/ref
columns :- [:sequential ::lib.schema.metadata/column]]
(if-let [no-implicit (not-empty (remove :fk-field-id columns))]
(if-not (next no-implicit)
(first no-implicit)
(disambiguate-matches-dislike-field-refs-to-expressions a-ref no-implicit))
nil)) | |
(mu/defn ^:private disambiguate-matches-no-alias :- [:maybe ::lib.schema.metadata/column]
[a-ref :- ::lib.schema.ref/ref
columns :- [:sequential ::lib.schema.metadata/column]]
;; a-ref without :join-alias - if exactly one column has no :source-alias, that's the match.
;; ignore the source alias on columns with :source/card or :source/fields
(if-let [no-alias (not-empty (remove #(and (column-join-alias %)
(not (#{:source/card} (:lib/source %))))
columns))]
;; At least 1 matching column with no :source-alias.
(if-not (next no-alias)
(first no-alias)
;; More than 1, keep digging.
(disambiguate-matches-prefer-explicit a-ref no-alias))
;; No columns are missing :source-alias - pass them all to the next stage.
;; TODO: I'm not certain this one is sound, but it's necessary to make `lib.join/select-home-column` work as
;; written. If this case causes issues, that logic may need rewriting.
nil)) | |
(mu/defn ^:private disambiguate-matches :- [:maybe ::lib.schema.metadata/column]
[a-ref :- ::lib.schema.ref/ref
columns :- [:sequential ::lib.schema.metadata/column]]
(let [{:keys [join-alias]} (lib.options/options a-ref)]
(if join-alias
;; a-ref has a :join-alias, match on that. Return nil if nothing matches.
(when-let [matches (not-empty (filter #(clojure.core/= (column-join-alias %) join-alias) columns))]
(if-not (next matches)
(first matches)
(#?(:cljs js/console.warn :clj log/warn)
"Multiple plausible matches with the same :join-alias - more disambiguation needed"
{:ref a-ref
:matches matches})
#_(throw (ex-info "Multiple plausible matches with the same :join-alias - more disambiguation needed"
{:ref a-ref
:matches matches}))))
(disambiguate-matches-no-alias a-ref columns)))) | |
(def ^:private FindMatchingColumnOptions
[:map [:generous? {:optional true} :boolean]]) | |
(mu/defn find-matching-column :- [:maybe ::lib.schema.metadata/column]
"Given `a-ref-or-column` and a list of `columns`, finds the column that best matches this ref or column.
Matching is based on finding the basically plausible matches first. There is often zero or one plausible matches, and
this can return quickly.
If there are multiple plausible matches, they are disambiguated by the most important extra included in the `ref`.
(`:join-alias` first, then `:temporal-unit`, etc.)
- Integer IDs in the `ref` are matched by ID; this usually is unambiguous.
- If there are multiple joins on one table (including possible implicit joins), check `:join-alias` next.
- If `a-ref` has a `:join-alias`, only a column which matches it can be the match, and it should be unique.
- If `a-ref` doesn't have a `:join-alias`, prefer the column with no `:join-alias`, and prefer already selected
columns over implicitly joinable ones.
- There may be broken cases where the ref has an ID but the column does not. Therefore the ID must be resolved to a
name or `:lib/desired-column-alias` and matched that way.
- `query` and `stage-number` are required for this case, since they're needed to resolve the correct name.
- Columns with `:id` set are dropped to prevent them matching. (If they didn't match by `:id` above they shouldn't
match by name due to a coincidence of column names in different tables.)
- String IDs are checked against `:lib/desired-column-alias` first.
- If that doesn't match any columns, `:name` is compared next.
- The same disambiguation (by `:join-alias` etc.) is applied if there are multiple plausible matches.
Returns the matching column, or nil if no match is found."
([a-ref columns]
(find-matching-column a-ref columns {}))
([[ref-kind _opts ref-id :as a-ref] :- ::lib.schema.ref/ref
columns :- [:sequential ::lib.schema.metadata/column]
{:keys [generous?]} :- FindMatchingColumnOptions]
(case ref-kind
;; Aggregations are referenced by the UUID of the column being aggregated.
:aggregation (m/find-first #(and (clojure.core/= (:lib/source %) :source/aggregations)
(clojure.core/= (:lib/source-uuid %) ref-id))
columns)
;; Expressions are referenced by name; fields by ID or name.
(:expression
:field) (let [plausible (if (string? ref-id)
(plausible-matches-for-name a-ref columns)
(plausible-matches-for-id a-ref columns generous?))]
(case (count plausible)
0 nil
1 (first plausible)
(disambiguate-matches a-ref plausible)))
(throw (ex-info "Unknown type of ref" {:ref a-ref}))))
([query stage-number a-ref-or-column columns]
(find-matching-column query stage-number a-ref-or-column columns {}))
([query :- [:maybe ::lib.schema/query]
stage-number :- :int
a-ref-or-column :- [:or ::lib.schema.metadata/column ::lib.schema.ref/ref]
columns :- [:sequential ::lib.schema.metadata/column]
opts :- FindMatchingColumnOptions]
(let [[ref-kind ref-opts ref-id :as a-ref] (if (lib.util/clause? a-ref-or-column)
a-ref-or-column
(lib.ref/ref a-ref-or-column))]
(or (find-matching-column a-ref columns opts)
;; Aggregations are matched by `:source-uuid` but if we're comparing old columns to new refs or vice versa
;; the random UUIDs won't match up. This falls back to the `:lib/source-name` option on aggregation refs, if
;; present.
(when (and (= ref-kind :aggregation)
(:lib/source-name ref-opts))
(m/find-first #(and (= (:lib/source %) :source/aggregations)
(= (:name %) (:lib/source-name ref-opts)))
columns))
;; We failed to match by ID, so try again with the column's name. Any columns with `:id` set are dropped.
;; Why? Suppose there are two CREATED_AT columns in play - if one has an :id and it failed to match above, then
;; it certainly shouldn't match by name just because of the coincidence of column names!
(when (and query (number? ref-id))
(when-let [no-id-columns (not-empty (remove :id columns))]
(when-let [resolved (if (lib.util/clause? a-ref-or-column)
(resolve-field-id query stage-number ref-id)
a-ref-or-column)]
(find-matching-column (-> (assoc a-ref 2 (or (:lib/desired-column-alias resolved)
(:name resolved)))
;; make sure the :field ref has a `:base-type`, it's against the rules for a
;; nominal :field ref not to have a base-type -- this can fail schema
;; validation if it's missing in the Field ID ref we generate the nominal ref
;; from.
(lib.options/update-options (partial merge {:base-type :type/*})))
no-id-columns
opts)))))))) | |
(defn- ref-id-or-name [[_ref-kind _opts id-or-name]] id-or-name) | |
(mu/defn find-matching-ref :- [:maybe ::lib.schema.ref/ref]
"Given `column` and a list of `refs`, finds the ref that best matches this column.
Throws if there are multiple, ambiguous matches.
Returns the matching ref, or nil if no plausible matches are found."
[column :- ::lib.schema.metadata/column
refs :- [:sequential ::lib.schema.ref/ref]]
(let [ref-tails (group-by ref-id-or-name refs)
matches (or (some->> column :lib/source-uuid (get ref-tails) not-empty)
(not-empty (get ref-tails (:id column)))
(not-empty (get ref-tails (:lib/desired-column-alias column)))
(get ref-tails (:name column))
[])]
(case (count matches)
0 nil
1 (first matches)
(throw (ex-info "Ambiguous match: given column matches multiple refs"
{:column column
:matching-refs matches}))))) | |
(mu/defn find-column-indexes-for-refs :- [:sequential :int]
"Given a list `haystack` of columns or refs, and a list `needles` of refs to searc for, this returns a list parallel
to `needles` with the corresponding index into the `haystack`, or -1 if not found.
DISCOURAGED: This is intended for use only by [[metabase.lib.js/find-column-indexes-from-legacy-refs]].
Other MLv2 code should use [[find-matching-column]] if the `haystack` is columns, or
[[find-matching-ref]] if it's refs."
[query :- ::lib.schema/query
stage-number :- :int
needles :- [:sequential ::lib.schema.ref/ref]
haystack :- [:sequential ::lib.schema.metadata/column]]
(let [by-column (into {}
(map-indexed (fn [index column]
[column index]))
haystack)]
(for [needle needles
:let [matched (find-matching-column query stage-number needle haystack)]]
(get by-column matched -1)))) | |
TODO: Refactor this away. Handle legacy refs in | (mu/defn find-column-for-legacy-ref :- [:maybe ::lib.schema.metadata/column]
"Like [[find-matching-column]], but takes a legacy MBQL reference. The name here is for consistency with other
FE names for similar functions."
([query legacy-ref metadatas]
(find-column-for-legacy-ref query -1 legacy-ref metadatas))
([query :- ::lib.schema/query
stage-number :- :int
legacy-ref :- :some
metadatas :- [:maybe [:sequential ::lib.schema.metadata/column]]]
(find-matching-column query stage-number (lib.convert/legacy-ref->pMBQL query stage-number legacy-ref) metadatas))) |
Mark Example usage: ;; example (simplified) implementation of [[metabase.lib.field/fieldable-columns]]
;;
;; return (visibile-columns query), but if any of those appear in | (defn mark-selected-columns
([cols selected-columns-or-refs]
(mark-selected-columns nil -1 cols selected-columns-or-refs))
([query stage-number cols selected-columns-or-refs]
(when (seq cols)
(let [selected-refs (mapv lib.ref/ref selected-columns-or-refs)
matching-selected-cols (into #{}
(map #(find-matching-column query stage-number % cols))
selected-refs)]
(mapv #(assoc % :selected? (contains? matching-selected-cols %)) cols))))) |
(mu/defn matching-column-sets? :- :boolean
"Returns true if the provided `refs` is the same set as the provided `columns`.
Order is ignored. Only returns true if each of the `refs` matches a column, and each of the `columns` is matched by
exactly 1 of the `refs`. (A bijection, in math terms.)"
[query :- ::lib.schema/query
stage-number :- :int
refs :- [:sequential ::lib.schema.ref/ref]
columns :- [:sequential ::lib.schema.metadata/column]]
;; The lists match iff:
;; - Each ref matches a column; AND
;; - Each column was matched by exactly one ref
;; So we return true if nil is not a key in the matching, AND all vals in the matching have length 1,
;; AND the matching has as many elements as `columns` (usually the list of columns returned by default).
(and (= (count refs) (count columns))
(let [matching (group-by #(find-matching-column query stage-number % columns) refs)]
(and (not (contains? matching nil))
(= (count matching) (count columns))
(every? #(= (count %) 1) (vals matching)))))) | |
(ns metabase.util.format
#?(:clj (:require
[colorize.core :as colorize]
[metabase.config :as config])
:cljs (:require
[goog.string :as gstring]))) | |
(defn- format-with-unit [n suffix]
#?(:clj (format "%.1f %s" n suffix)
:cljs (str (.toFixed n 1) " " suffix))) | |
Format a time interval in nanoseconds to something more readable. (µs/ms/etc.) | (defn format-nanoseconds
^String [nanoseconds]
;; The basic idea is to take `n` and see if it's greater than the divisior. If it is, we'll print it out as that
;; unit. If more, we'll divide by the divisor and recur, trying each successively larger unit in turn. e.g.
;;
;; (format-nanoseconds 500) ; -> "500 ns"
;; (format-nanoseconds 500000) ; -> "500 µs"
(loop [n nanoseconds, [[unit divisor] & more] [[:ns 1000] [:µs 1000] [:ms 1000] [:s 60] [:mins 60] [:hours 24]
[:days 7] [:weeks (/ 365.25 7)]
[:years #?(:clj Double/POSITIVE_INFINITY
:cljs js/Number.POSITIVE_INFINITY)]]]
(if (and (> n divisor)
(seq more))
(recur (/ n divisor) more)
(format-with-unit (double n) (name unit))))) |
Format a time interval in microseconds into something more readable. | (defn format-microseconds ^String [microseconds] (format-nanoseconds (* 1000.0 microseconds))) |
Format a time interval in milliseconds into something more readable. | (defn format-milliseconds ^String [milliseconds] (format-microseconds (* 1000.0 milliseconds))) |
Format a time interval in seconds into something more readable. | (defn format-seconds ^String [seconds] (format-milliseconds (* 1000.0 seconds))) |
Nicely format (format-bytes 1024) ; -> 2.0 KB | (defn format-bytes
[num-bytes]
(loop [n num-bytes [suffix & more] ["B" "KB" "MB" "GB"]]
(if (and (seq more)
(>= n 1024))
(recur (/ n 1024.0) more)
(format-with-unit n suffix)))) |
#?(:clj
(def ^:private colorize?
;; As of 0.35.0 we support the NO_COLOR env var. See https://no-color.org/ (But who hates color logs?)
(if (config/config-str :no-color)
false
(config/config-bool :mb-colorize-logs)))) | |
Colorize string | (def ^{:arglists '(^String [color-symb x])} colorize
#?(:clj (if colorize?
(fn [color x]
(colorize/color (keyword color) (str x)))
(fn [_ x]
(str x)))
:cljs (fn [_ x]
(str x)))) |
With one arg, converts something to a string and colorizes it. With two args, behaves like (format-color :red "%d cans" 2) | (defn format-color
{:arglists '(^String [color x] ^String [color format-string & args])}
(^String [color x]
(colorize color x))
(^String [color format-str & args]
(colorize color (apply #?(:clj format :cljs gstring/format) format-str args)))) |
Malli schemas for string, temporal, number, and boolean literals. | (ns metabase.lib.schema.literal (:require #?@(:clj ([metabase.lib.schema.literal.jvm])) [malli.core :as mc] [metabase.lib.schema.common :as common] [metabase.lib.schema.expression :as expression] [metabase.lib.schema.mbql-clause :as mbql-clause] [metabase.shared.util.internal.time-common :as shared.ut.common] [metabase.util.malli.registry :as mr])) |
(defmethod expression/type-of-method :dispatch-type/nil [_nil] :type/*) | |
(mr/def ::boolean :boolean) | |
(defmethod expression/type-of-method :dispatch-type/boolean [_bool] :type/Boolean) | |
(mr/def ::boolean :boolean) | |
(mr/def ::integer
#?(:clj [:or
:int
:metabase.lib.schema.literal.jvm/big-integer]
:cljs :int)) | |
(defmethod expression/type-of-method :dispatch-type/integer [_int] :type/Integer) | |
we should probably also restrict this to disallow NaN and positive/negative infinity, I don't know in what universe we'd want to allow those if they're not disallowed already. | (mr/def ::non-integer-real
#?(:clj [:or
:double
:metabase.lib.schema.literal.jvm/float
:metabase.lib.schema.literal.jvm/big-decimal]
:cljs :double)) |
(defmethod expression/type-of-method :dispatch-type/number [_non-integer-real] ;; `:type/Float` is the 'base type' of all non-integer real number types in [[metabase.types]] =( :type/Float) | |
(mr/def ::string :string) | |
TODO -- these temporal literals could be a little stricter, right now they are pretty permissive, you shouldn't be
allowed to have month | (mr/def ::string.date
[:re
{:error/message "date string literal"}
shared.ut.common/local-date-regex]) |
(mr/def ::string.zone-offset
[:re
{:error/message "timezone offset string literal"}
shared.ut.common/zone-offset-part-regex]) | |
(mr/def ::string.time
[:or
[:re
{:error/message "local time string literal"}
shared.ut.common/local-time-regex]
[:re
{:error/message "offset time string literal"}
shared.ut.common/offset-time-regex]]) | |
(mr/def ::string.datetime
[:or
[:re
{:error/message "local date time string literal"}
shared.ut.common/local-datetime-regex]
[:re
{:error/message "offset date time string literal"}
shared.ut.common/offset-datetime-regex]]) | |
(defmethod expression/type-of-method :dispatch-type/string
[s]
(condp mc/validate s
::string.datetime #{:type/Text :type/DateTime}
::string.date #{:type/Text :type/Date}
::string.time #{:type/Text :type/Time}
:type/Text)) | |
(mr/def ::date
#?(:clj [:or
[:time/local-date {:error/message "instance of java.time.LocalDate"}]
::string.date]
:cljs ::string.date)) | |
(mr/def ::time
#?(:clj [:or
::string.time
[:time/local-time {:error/message "instance of java.time.LocalTime"}]
[:time/offset-time {:error/message "instance of java.time.OffsetTime"}]]
:cljs ::string.time)) | |
(mr/def ::datetime
#?(:clj [:or
::string.datetime
[:time/local-date-time {:error/message "instance of java.time.LocalDateTime"}]
[:time/offset-date-time {:error/message "instance of java.time.OffsetDateTime"}]
[:time/zoned-date-time {:error/message "instance of java.time.ZonedDateTime"}]]
:cljs ::string.datetime)) | |
(mr/def ::temporal [:or ::date ::time ::datetime]) | |
these are currently only allowed inside | |
(mr/def ::string.year-month
[:re
{:error/message "year-month string literal"}
shared.ut.common/year-month-regex]) | |
(mr/def ::string.year
[:re
{:error/message "year string literal"}
shared.ut.common/year-regex]) | |
| (mr/def ::value.options
[:merge
[:ref ::common/options]
[:map
[:effective-type ::common/base-type]]]) |
[:value The schema itself does not currently enforce that the actual | (mbql-clause/define-mbql-clause :value
[:tuple
{:error/message "Value :value clause"}
#_tag [:= :value]
#_opts [:ref ::value.options]
#_value any?]) |
(ns metabase.util.malli
(:refer-clojure :exclude [fn defn defmethod])
(:require
#?@(:clj
([metabase.util.i18n]
[metabase.util.malli.defn :as mu.defn]
[metabase.util.malli.fn :as mu.fn]
[net.cgrand.macrovich :as macros]
[potemkin :as p]))
[clojure.core :as core]
[malli.core :as mc]
[malli.destructure]
[malli.error :as me]
[malli.util :as mut]
[metabase.shared.util.i18n :as i18n])
#?(:cljs (:require-macros [metabase.util.malli]))) | |
#?(:clj
(p/import-vars
[mu.fn fn]
[mu.defn defn])) | |
Pass into mu/humanize to include the value received in the error message. | (core/defn humanize-include-value
[{:keys [value message]}]
;; TODO Should this be translated with more complete context? (tru "{0}, received: {1}" message (pr-str value))
(str message ", " (i18n/tru "received") ": " (pr-str value))) |
Explains a schema failure, and returns the offending value. | (core/defn explain
[schema value]
(-> (mc/explain schema value)
(me/humanize {:wrap humanize-include-value}))) |
(def ^:private Schema
[:and any?
[:fn {:description "a malli schema"} mc/schema]]) | |
Schema for localized string. | (def localized-string-schema
#?(:clj [:fn {:error/message "must be a localized string"}
metabase.util.i18n/localized-string?]
;; TODO Is there a way to check if a string is being localized in CLJS, by the `ttag`?
;; The compiler seems to just inline the translated strings with no annotation or wrapping.
:cljs :string)) |
Update a malli schema to have a :description (used by umd/describe, which is used by api docs), and a :error/fn (used by me/humanize, which is used by defendpoint). They don't have to be the same, but usually are. (with-api-error-message [:string {:min 1}] (deferred-tru "Must be a string with at least 1 character representing a User ID.")) Kondo gets confused by :refer [defn] on this, so it's referenced fully qualified. | (metabase.util.malli/defn with-api-error-message
{:style/indent [:form]}
([mschema :- Schema error-message :- localized-string-schema]
(with-api-error-message mschema error-message error-message))
([mschema :- :any
description-message :- localized-string-schema
specific-error-message :- localized-string-schema]
(mut/update-properties (mc/schema mschema) assoc
;; override generic description in api docs and :errors key in API's response
:description description-message
;; override generic description in :specific-errors key in API's response
:error/fn (constantly specific-error-message)))) |
Convenience for disabling [[defn]] and [[metabase.util.malli.fn/fn]] input/output schema validation. Since input/output validation is currently disabled for ClojureScript, this is a no-op. | #?(:clj
(defmacro disable-enforcement
{:style/indent 0}
[& body]
(macros/case
:clj
`(binding [mu.fn/*enforce* false]
~@body)
:cljs
`(do ~@body)))) |
Impl for [[defmethod]] for regular Clojure. Impl for [[defmethod]] for ClojureScript. | #?(:clj
(defmacro -defmethod-clj
[multifn dispatch-value & fn-tail]
(let [dispatch-value-symb (gensym "dispatch-value-")
error-context-symb (gensym "error-context-")]
`(let [~dispatch-value-symb ~dispatch-value
~error-context-symb {:fn-name '~(or (some-> (resolve multifn) symbol)
(symbol multifn))
:dispatch-value ~dispatch-value-symb}
f# ~(mu.fn/instrumented-fn-form error-context-symb (mu.fn/parse-fn-tail fn-tail))]
(.addMethod ~(vary-meta multifn assoc :tag 'clojure.lang.MultiFn)
~dispatch-value-symb
f#)))))
#?(:clj
(defmacro -defmethod-cljs
[multifn dispatch-value & fn-tail]
`(core/defmethod ~multifn ~dispatch-value
~@(mu.fn/deparameterized-fn-tail (mu.fn/parse-fn-tail fn-tail))))) |
Like [[schema.core/defmethod]], but for Malli. | #?(:clj
(defmacro defmethod
[multifn dispatch-value & fn-tail]
(macros/case
:clj `(-defmethod-clj ~multifn ~dispatch-value ~@fn-tail)
:cljs `(-defmethod-cljs ~multifn ~dispatch-value ~@fn-tail)))) |
Returns the value if it matches the schema, else throw an exception. | #?(:clj
(defn validate-throw
[schema-or-validator value]
(if-not ((if (fn? schema-or-validator)
schema-or-validator
(mc/validator schema-or-validator))
value)
(throw (ex-info "Value does not match schema" {:value value :schema schema-or-validator}))
value))) |
Code related to the new writeback Actions. | (ns metabase.actions (:require [clojure.spec.alpha :as s] [malli.core :as mc] [malli.error :as me] [metabase.api.common :as api] [metabase.driver :as driver] [metabase.lib.metadata :as lib.metadata] [metabase.mbql.normalize :as mbql.normalize] [metabase.mbql.schema :as mbql.s] [metabase.mbql.util :as mbql.u] [metabase.models :refer [Database]] [metabase.models.setting :as setting] [metabase.query-processor.error-type :as qp.error-type] [metabase.query-processor.middleware.permissions :as qp.perms] [metabase.query-processor.store :as qp.store] [metabase.util :as u] [metabase.util.i18n :as i18n] [toucan2.core :as t2])) |
(setting/defsetting database-enable-actions (i18n/deferred-tru "Whether to enable Actions for a specific Database.") :default false :type :boolean :visibility :public :database-local :only) | |
Normalize the | (defmulti normalize-action-arg-map
{:arglists '([action arg-map]), :added "0.44.0"}
(fn [action _arg-map]
(keyword action))) |
(defmethod normalize-action-arg-map :default [_action arg-map] arg-map) | |
Return the appropriate spec to use to validate the arg map passed to [[perform-action!*]]. (action-arg-map-spec :row/create) => :actions.args.crud/row.create | (defmulti action-arg-map-spec
{:arglists '([action]), :added "0.44.0"}
keyword) |
(defmethod action-arg-map-spec :default [_action] any?) | |
Multimethod for doing an Action. The specific At the time of this writing Actions are performed with either {:table-id The former endpoint is currently used for the various DON'T CALL THIS METHOD DIRECTLY TO PERFORM ACTIONS -- use [[perform-action!]] instead which does normalization, validation, and binds Database-local values. | (defmulti perform-action!*
{:arglists '([driver action database arg-map]), :added "0.44.0"}
(fn [driver action _database _arg-map]
[(driver/dispatch-on-initialized-driver driver)
(keyword action)])
:hierarchy #'driver/hierarchy) |
Set of all known actions. | (defn- known-actions
[]
(into #{}
(comp (filter sequential?)
(map second))
(keys (methods perform-action!*)))) |
(defmethod perform-action!* :default
[driver action _database _arg-map]
(let [action (keyword action)
known-actions (known-actions)]
;; return 404 if the action doesn't exist.
(when-not (contains? known-actions action)
(throw (ex-info (i18n/tru "Unknown Action {0}. Valid Actions are: {1}"
action
(pr-str known-actions))
{:status-code 404})))
;; return 400 if the action does exist but is not supported by this DB
(throw (ex-info (i18n/tru "Action {0} is not supported for {1} Databases."
action
(pr-str driver))
{:status-code 400})))) | |
A cache that lives for the duration of the top-level Action invoked by [[perform-action!]]. You can use this to store miscellaneous values such as things that need to be fetched from the application database to avoid duplicate calls in bulk actions that repeatedly call code that would only be called once by single-row Actions. Bound to an atom containing a map by [[perform-action!]]. | (def ^:dynamic *misc-value-cache* nil) |
Get a cached value from the [[misc-value-cache]] using a
[::cast-values table-id] is a good key. | (defn cached-value
[unique-key value-thunk]
(or (when *misc-value-cache*
(get @*misc-value-cache* unique-key))
(let [value (value-thunk)]
(when *misc-value-cache*
(swap! *misc-value-cache* assoc unique-key value))
value))) |
Throws an appropriate error if actions are unsupported or disabled for a database, otherwise returns nil. | (defn check-actions-enabled-for-database!
[{db-settings :settings db-id :id driver :engine db-name :name :as db}]
(when-not (driver/database-supports? driver :actions db)
(throw (ex-info (i18n/tru "{0} Database {1} does not support actions."
(u/qualified-name driver)
(format "%d %s" db-id (pr-str db-name)))
{:status-code 400, :database-id db-id})))
(binding [setting/*database-local-values* db-settings]
(when-not (database-enable-actions)
(throw (ex-info (i18n/tru "Actions are not enabled.")
{:status-code 400, :database-id db-id}))))
nil) |
(defn- database-for-action [action-or-id]
(t2/select-one Database {:select [:db.*]
:from :action
:join [[:report_card :card] [:= :card.id :action.model_id]
[:metabase_database :db] [:= :db.id :card.database_id]]
:where [:= :action.id (u/the-id action-or-id)]})) | |
Throws an appropriate error if actions are unsupported or disabled for the database of the action's model, otherwise returns nil. | (defn check-actions-enabled! [action-or-id] (check-actions-enabled-for-database! (api/check-404 (database-for-action action-or-id)))) |
Perform an | (defn perform-action!
[action arg-map]
(let [action (keyword action)
spec (action-arg-map-spec action)
arg-map (normalize-action-arg-map action arg-map)]
(when (s/invalid? (s/conform spec arg-map))
(throw (ex-info (format "Invalid Action arg map for %s: %s" action (s/explain-str spec arg-map))
(s/explain-data spec arg-map))))
(let [{driver :engine :as db} (api/check-404 (qp.store/with-metadata-provider (:database arg-map)
(lib.metadata/database (qp.store/metadata-provider))))]
(check-actions-enabled-for-database! db)
(binding [*misc-value-cache* (atom {})]
(qp.perms/check-query-action-permissions* arg-map)
(driver/with-driver driver
(perform-action!* driver action db arg-map)))))) |
Action definitions. | |
Common base spec for all Actions. All Actions at least require {:database Anything else required depends on the action type. | |
(s/def :actions.args/id (s/and integer? pos?)) | |
(s/def :actions.args.common/database :actions.args/id) | |
(s/def :actions.args/common (s/keys :req-un [:actions.args.common/database])) | |
Common base spec for all CRUD row Actions. All CRUD row Actions at least require {:database | |
(s/def :actions.args.crud.row.common.query/source-table :actions.args/id) | |
(s/def :actions.args.crud.row.common/query (s/keys :req-un [:actions.args.crud.row.common.query/source-table])) | |
(s/def :actions.args.crud.row/common (s/merge :actions.args/common (s/keys :req-un [:actions.args.crud.row.common/query]))) | |
the various | |
Normalize | (defn- normalize-as-mbql-query
([query]
(let [query (mbql.normalize/normalize (assoc query :type :query))]
(when-let [error (me/humanize (mc/explain mbql.s/Query query))]
(throw (ex-info
(i18n/tru "Invalid query: {0}" (pr-str error))
{:status-code 400, :type qp.error-type/invalid-query})))
query))
([query & {:keys [exclude]}]
(let [query (update-keys query mbql.u/normalize-token)]
(merge (select-keys query exclude)
(normalize-as-mbql-query (apply dissoc query exclude)))))) |
| |
row/create requires at least {:database | |
(defmethod normalize-action-arg-map :row/create
[_action query]
(normalize-as-mbql-query query :exclude #{:create-row})) | |
(s/def :actions.args.crud.row.create/create-row (s/map-of keyword? any?)) | |
(s/def :actions.args.crud/row.create (s/merge :actions.args.crud.row/common (s/keys :req-un [:actions.args.crud.row.create/create-row]))) | |
(defmethod action-arg-map-spec :row/create [_action] :actions.args.crud/row.create) | |
| |
row/update requires at least {:database | |
(defmethod normalize-action-arg-map :row/update
[_action query]
(normalize-as-mbql-query query :exclude #{:update-row})) | |
(s/def :actions.args.crud.row.update.query/filter vector?) ; MBQL filter clause | |
(s/def :actions.args.crud.row.update/query (s/merge :actions.args.crud.row.common/query (s/keys :req-un [:actions.args.crud.row.update.query/filter]))) | |
(s/def :actions.args.crud.row.update/update-row (s/map-of keyword? any?)) | |
(s/def :actions.args.crud/row.update
(s/merge
:actions.args.crud.row/common
(s/keys :req-un [:actions.args.crud.row.update/update-row
:actions.args.crud.row.update/query]))) | |
(defmethod action-arg-map-spec :row/update [_action] :actions.args.crud/row.update) | |
| |
row/delete requires at least {:database | |
(defmethod normalize-action-arg-map :row/delete [_action query] (normalize-as-mbql-query query)) | |
(s/def :actions.args.crud.row.delete.query/filter vector?) ; MBQL filter clause | |
(s/def :actions.args.crud.row.delete/query (s/merge :actions.args.crud.row.common/query (s/keys :req-un [:actions.args.crud.row.delete.query/filter]))) | |
(s/def :actions.args.crud/row.delete (s/merge :actions.args.crud.row/common (s/keys :req-un [:actions.args.crud.row.delete/query]))) | |
(defmethod action-arg-map-spec :row/delete [_action] :actions.args.crud/row.delete) | |
Bulk actions | |
All bulk Actions require at least {:database | |
(s/def :actions.args.crud.bulk.common/table-id :actions.args/id) | |
(s/def :actions.args.crud.bulk/rows (s/cat :rows (s/+ (s/map-of string? any?)))) | |
(s/def :actions.args.crud.bulk/common
(s/merge
:actions.args/common
(s/keys :req-un [:actions.args.crud.bulk.common/table-id
:actions.args.crud.bulk/rows]))) | |
The request bodies for the bulk CRUD actions are all the same. The body of a request to `POST /api/action/:action-namespace/:action-name/:table-id` is just a vector of rows but the API endpoint itself calls [[perform-action!]] with {:database and we transform this to
| |
| |
(defn- normalize-bulk-crud-action-arg-map
[{:keys [database table-id], rows :arg, :as _arg-map}]
{:type :query, :query {:source-table table-id}
:database database, :table-id table-id, :rows (map #(update-keys % u/qualified-name) rows)}) | |
(defmethod normalize-action-arg-map :bulk/create [_action arg-map] (normalize-bulk-crud-action-arg-map arg-map)) | |
(defmethod action-arg-map-spec :bulk/create [_action] :actions.args.crud.bulk/common) | |
(defmethod normalize-action-arg-map :bulk/update [_action arg-map] (normalize-bulk-crud-action-arg-map arg-map)) | |
(defmethod action-arg-map-spec :bulk/update [_action] :actions.args.crud.bulk/common) | |
| |
Request-body should look like: ;; single pk, two rows [{"ID": 76}, {"ID": 77}] ;; multiple pks, one row [{"PK1": 1, "PK2": "john"}] | |
(defmethod normalize-action-arg-map :bulk/delete [_action arg-map] (normalize-bulk-crud-action-arg-map arg-map)) | |
(defmethod action-arg-map-spec :bulk/delete [_action] :actions.args.crud.bulk/common) | |
(ns metabase.actions.error) | |
Error type for SQL unique constraint violation. | (def violate-unique-constraint ::violate-unique-constraint) |
Error type for SQL not null constraint violation. | (def violate-not-null-constraint ::violate-not-null-constraint) |
Error type for SQL foreign key constraint violation. | (def violate-foreign-key-constraint ::violate-foreign-key-constraint) |
Error type for SQL incorrect value type. | (def incorrect-value-type ::incorrect-value-type) |
(ns metabase.actions.execution (:require [clojure.set :as set] [medley.core :as m] [metabase.actions :as actions] [metabase.actions.http-action :as http-action] [metabase.analytics.snowplow :as snowplow] [metabase.api.common :as api] [metabase.models :refer [Card DashboardCard Database Table]] [metabase.models.action :as action] [metabase.models.persisted-info :as persisted-info] [metabase.models.query :as query] [metabase.query-processor :as qp] [metabase.query-processor.card :as qp.card] [metabase.query-processor.error-type :as qp.error-type] [metabase.query-processor.middleware.permissions :as qp.perms] [metabase.query-processor.writeback :as qp.writeback] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log] [toucan2.core :as t2])) | |
Execute a
| (defn- execute-query-action!
[{:keys [dataset_query model_id] :as action} request-parameters]
(log/tracef "Executing action\n\n%s" (u/pprint-to-str action))
(try
(let [parameters (for [parameter (:parameters action)]
(assoc parameter :value (get request-parameters (:id parameter))))
query (-> dataset_query
(update :type keyword)
(assoc :parameters parameters))]
(log/debugf "Query (before preprocessing):\n\n%s" (u/pprint-to-str query))
(binding [qp.perms/*card-id* model_id]
(qp.writeback/execute-write-query! query)))
(catch Throwable e
(if (= (:type (u/all-ex-data e)) qp.error-type/missing-required-permissions)
(api/throw-403 e)
(throw (ex-info (format "Error executing Action: %s" (ex-message e))
{:action action
:parameters request-parameters}
e)))))) |
(defn- implicit-action-table
[card_id]
(let [card (t2/select-one Card :id card_id)
{:keys [table-id]} (query/query->database-and-table-ids (:dataset_query card))]
(t2/hydrate (t2/select-one Table :id table-id) :fields))) | |
(defn- execute-custom-action [action request-parameters]
(let [{action-type :type} action]
(actions/check-actions-enabled! action)
(let [model (t2/select-one Card :id (:model_id action))]
(when (and (= action-type :query) (not= (:database_id model) (:database_id action)))
;; the above check checks the db of the model. We check the db of the query action here
(actions/check-actions-enabled-for-database!
(t2/select-one Database :id (:database_id action)))))
(try
(case action-type
:query
(execute-query-action! action request-parameters)
:http
(http-action/execute-http-action! action request-parameters))
(catch Exception e
(log/error e "Error executing action.")
(if-let [ed (ex-data e)]
(let [ed (cond-> ed
(and (nil? (:status-code ed))
(= (:type ed) :missing-required-permissions))
(assoc :status-code 403)
(nil? (:message ed))
(assoc :message (ex-message e)))]
(if (= (ex-data e) ed)
(throw e)
(throw (ex-info (ex-message e) ed e))))
{:body {:message (or (ex-message e) (tru "Error executing action."))}
:status 500}))))) | |
Check that the given request parameters do not contain any parameters that are not in the given set of destination parameter ids | (defn- check-no-extra-parameters
[request-parameters destination-param-ids]
(let [extra-parameters (set/difference (set (keys request-parameters))
(set destination-param-ids))]
(api/check (empty? extra-parameters)
400
{:status-code 400
:message (tru "No destination parameter found for {0}. Found: {1}"
(pr-str extra-parameters)
(pr-str destination-param-ids))
:type qp.error-type/invalid-parameter
:parameters request-parameters
:destination-parameters destination-param-ids}))) |
(defn- build-implicit-query
[{:keys [model_id parameters] :as _action} implicit-action request-parameters]
(let [{database-id :db_id
table-id :id :as table} (implicit-action-table model_id)
table-fields (:fields table)
pk-fields (filterv #(isa? (:semantic_type %) :type/PK) table-fields)
slug->field-name (->> table-fields
(map (juxt (comp u/slugify :name) :name))
(into {})
(m/filter-keys (set (map :id parameters))))
_ (api/check (action/unique-field-slugs? table-fields)
400
(tru "Cannot execute implicit action on a table with ambiguous column names."))
_ (api/check (= (count pk-fields) 1)
400
(tru "Must execute implicit action on a table with a single primary key."))
_ (check-no-extra-parameters request-parameters (keys slug->field-name))
pk-field (first pk-fields)
;; Ignore params with nil values; the client doesn't reliably omit blank, optional parameters from the
;; request. See discussion at #29049
simple-parameters (->> (update-keys request-parameters (comp keyword slug->field-name))
(filter (fn [[_k v]] (some? v)))
(into {}))
pk-field-name (keyword (:name pk-field))
row-parameters (cond-> simple-parameters
(not= implicit-action :row/create) (dissoc pk-field-name))
requires_pk (contains? #{:row/delete :row/update} implicit-action)]
(api/check (or (not requires_pk)
(some? (get simple-parameters pk-field-name)))
400
(tru "Missing primary key parameter: {0}"
(pr-str (u/slugify (:name pk-field)))))
(cond->
{:query {:database database-id,
:type :query,
:query {:source-table table-id}}
:row-parameters row-parameters}
requires_pk
(assoc-in [:query :query :filter]
[:= [:field (:id pk-field) nil] (get simple-parameters pk-field-name)])
requires_pk
(assoc :prefetch-parameters [{:target [:dimension [:field (:id pk-field) nil]]
:type "id"
:value [(get simple-parameters pk-field-name)]}])))) | |
(defn- execute-implicit-action
[action request-parameters]
(let [implicit-action (keyword (:kind action))
{:keys [query row-parameters]} (build-implicit-query action implicit-action request-parameters)
_ (api/check (or (= implicit-action :row/delete) (seq row-parameters))
400
(tru "Implicit parameters must be provided."))
arg-map (cond-> query
(= implicit-action :row/create)
(assoc :create-row row-parameters)
(= implicit-action :row/update)
(assoc :update-row row-parameters))]
(binding [qp.perms/*card-id* (:model_id action)]
(actions/perform-action! implicit-action arg-map)))) | |
Execute the given action with the given parameters of shape `{ | (defn execute-action!
[action request-parameters]
(let [;; if a value is supplied for a hidden parameter, it should raise an error
field-settings (get-in action [:visualization_settings :fields])
hidden-param-ids (->> (vals field-settings)
(filter :hidden)
(map :id))
destination-param-ids (set/difference (set (map :id (:parameters action))) (set hidden-param-ids))
_ (check-no-extra-parameters request-parameters destination-param-ids)
;; add default values for missing parameters (including hidden ones)
all-param-ids (set (map :id (:parameters action)))
provided-param-ids (set (keys request-parameters))
missing-param-ids (set/difference all-param-ids provided-param-ids)
missing-param-defaults (into {}
(keep (fn [param-id]
(when-let [default-value (get-in field-settings [param-id :defaultValue])]
[param-id default-value])))
missing-param-ids)
request-parameters (merge missing-param-defaults request-parameters)]
(case (:type action)
:implicit
(execute-implicit-action action request-parameters)
(:query :http)
(execute-custom-action action request-parameters)
(throw (ex-info (tru "Unknown action type {0}." (name (:type action))) action))))) |
Execute the given action in the dashboard/dashcard context with the given parameters
of shape `{ | (defn execute-dashcard!
[dashboard-id dashcard-id request-parameters]
(let [dashcard (api/check-404 (t2/select-one DashboardCard
:id dashcard-id
:dashboard_id dashboard-id))
action (api/check-404 (action/select-action :id (:action_id dashcard)))]
(snowplow/track-event! ::snowplow/action-executed api/*current-user-id* {:source :dashboard
:type (:type action)
:action_id (:id action)})
(execute-action! action request-parameters))) |
(defn- fetch-implicit-action-values
[action request-parameters]
(api/check (contains? #{"row/update" "row/delete"} (:kind action))
400
(tru "Values can only be fetched for actions that require a Primary Key."))
(let [implicit-action (keyword (:kind action))
{:keys [prefetch-parameters]} (build-implicit-query action implicit-action request-parameters)
info {:executed-by api/*current-user-id*
:context :action
:action-id (:id action)}
card (t2/select-one Card :id (:model_id action))
;; prefilling a form with day old data would be bad
result (binding [persisted-info/*allow-persisted-substitution* false]
(qp/process-query-and-save-execution!
(qp.card/query-for-card card prefetch-parameters nil nil)
info))
;; only expose values for fields that are not hidden
hidden-param-ids (keep #(when (:hidden %) (:id %))
(vals (get-in action [:visualization_settings :fields])))
exposed-param-ids (-> (set (map :id (:parameters action)))
(set/difference (set hidden-param-ids)))]
(m/filter-keys
#(contains? exposed-param-ids %)
(zipmap
(map (comp u/slugify :name) (get-in result [:data :cols]))
(first (get-in result [:data :rows])))))) | |
Fetch values to pre-fill implicit action execution - custom actions will return no values.
Must pass in parameters of shape | (defn fetch-values
[action request-parameters]
(if (= :implicit (:type action))
(fetch-implicit-action-values action request-parameters)
{})) |
(ns metabase.actions.http-action (:require [cheshire.core :as json] [clj-http.client :as http] [clojure.string :as str] [metabase.driver.common.parameters :as params] [metabase.driver.common.parameters.parse :as params.parse] [metabase.query-processor.error-type :as qp.error-type] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log]) (:import (com.fasterxml.jackson.databind ObjectMapper) (net.thisptr.jackson.jq BuiltinFunctionLoader JsonQuery Output Scope Versions))) | |
(set! *warn-on-reflection* true) | |
(defonce ^:private root-scope
(delay
(let [scope (Scope/newEmptyScope)]
(.loadFunctions (BuiltinFunctionLoader/getInstance) Versions/JQ_1_6 scope)))) | |
(defonce ^:private object-mapper (delay (ObjectMapper.))) | |
Largely copied from sql drivers param substitute. May go away if parameters substitution is taken out of query-processing/db dependency | (declare substitute*) |
(defn- substitute-param [param->value [sql missing] _in-optional? {:keys [k]}]
(if-not (contains? param->value k)
[sql (conj missing k)]
(let [v (get param->value k)]
(cond
(= params/no-value v)
[sql (conj missing k)]
:else
[(str sql v) missing])))) | |
(defn- substitute-optional [param->value [sql missing] {subclauses :args}]
(let [[opt-sql opt-missing] (substitute* param->value subclauses true)]
(if (seq opt-missing)
[sql missing]
[(str sql opt-sql) missing]))) | |
Returns a sequence of | (defn- substitute*
[param->value parsed in-optional?]
(reduce
(fn [[sql missing] x]
(cond
(string? x)
[(str sql x) missing]
(params/Param? x)
(substitute-param param->value [sql missing] in-optional? x)
(params/Optional? x)
(substitute-optional param->value [sql missing] x)))
nil
parsed)) |
Substitute (substitute ["https://example.com/?filter=" (param "bird_type")] {"bird_type" "Steller's Jay"}) ;; -> "https://example.com/?filter=Steller's Jay" | (defn substitute
[parsed-template param->value]
(log/tracef "Substituting params\n%s\nin template\n%s" (u/pprint-to-str param->value) (u/pprint-to-str parsed-template))
(let [[sql missing] (try
(substitute* param->value parsed-template false)
(catch Throwable e
(throw (ex-info (tru "Unable to substitute parameters: {0}" (ex-message e))
{:type (or (:type (ex-data e)) qp.error-type/qp)
:params param->value
:parsed-query parsed-template}
e))))]
(log/tracef "=>%s" sql)
(when (seq missing)
(throw (ex-info (tru "Cannot call the service: missing required parameters: {0}" (set missing))
{:type qp.error-type/missing-required-parameter
:missing missing})))
(str/trim sql))) |
(defn- parse-and-substitute [s params->value]
(when s
(-> s
params.parse/parse
(substitute params->value)))) | |
(deftype ActionOutput [results]
Output
(emit [_ x]
(vswap! results conj (str x)))) | |
Executes a jq query on [[object]]. | (defn apply-json-query
[object jq-query]
;; TODO this is pretty ineficient. We parse with `:as :json`, then reencode within a response
;; I couldn't find a way to get JSONNode out of cheshire, so we fall back to jackson.
;; Should jackson be added explicitly to deps.edn?
(let [json-node (.readTree ^ObjectMapper @object-mapper (json/generate-string object))
vresults (volatile! [])
output (ActionOutput. vresults)
expr (JsonQuery/compile jq-query Versions/JQ_1_6)
;; might need to Scope childScope = Scope.newChildScope(rootScope); if root-scope can be modified by expression
_ (.apply expr @root-scope json-node output)
results @vresults]
(if (<= (count results) 1)
(first results)
(throw (ex-info (tru "Too many results returned: {0}" (pr-str results)) {:jq-query jq-query :results results}))))) |
Calls an http endpoint based on action and params | (defn execute-http-action!
[action params->value]
(try
(let [{:keys [method url body headers]} (:template action)
request {:method (keyword method)
:url (parse-and-substitute url params->value)
:accept :json
:content-type :json
:throw-exceptions false
:headers (merge
;; TODO maybe we want to default Agent here? Maybe Origin/Referer?
{"X-Metabase-Action" (:name action)}
(-> headers
(parse-and-substitute params->value)
(json/decode)))
:body (parse-and-substitute body params->value)}
response (-> (http/request request)
(select-keys [:body :headers :status])
(update :body json/decode))
error (json/parse-string (apply-json-query response (or (:error_handle action) ".status >= 400")))]
(log/trace "Response before handle:" response)
(if error
{:status 400
:headers {"Content-Type" "application/json"}
:body (if (boolean? error)
{:remote-status (:status response)}
error)}
(if-some [response (some->> action :response_handle (apply-json-query response))]
{:status 200
:headers {"Content-Type" "application/json"}
:body response}
{:status 204
:body nil})))
(catch Exception e
(throw (ex-info (str "Problem building request: " (ex-message e))
{:template (:template action)}
e))))) |
Namespace for collection metrics with Prometheus. Will set up a registry and a webserver on startup
if [[prometheus-server-port]] is set to a port number. This can only be set in the environment (by starting with
Api is quite simple: [[setup!]] and [[shutdown!]]. After that you can retrieve metrics from
http://localhost: | (ns metabase.analytics.prometheus (:refer-clojure :exclude [inc]) (:require [clojure.java.jmx :as jmx] [iapetos.collector :as collector] [iapetos.collector.ring :as collector.ring] [iapetos.core :as prometheus] [metabase.models.setting :as setting :refer [defsetting]] [metabase.server :as server] [metabase.util.i18n :refer [deferred-trs trs]] [metabase.util.log :as log] [potemkin :as p] [potemkin.types :as p.types] [ring.adapter.jetty9 :as ring-jetty]) (:import (io.prometheus.client Collector GaugeMetricFamily) (io.prometheus.client.hotspot GarbageCollectorExports MemoryPoolsExports StandardExports ThreadExports) (io.prometheus.client.jetty JettyStatisticsCollector) (java.util ArrayList List) (javax.management ObjectName) (org.eclipse.jetty.server Server))) |
(set! *warn-on-reflection* true) | |
Infra: defsetting enables and [[system]] holds the system (webserver and registry) | |
(defsetting prometheus-server-port
(deferred-trs (str "Port to serve prometheus metrics from. If set, prometheus collectors are registered"
" and served from `localhost:<port>/metrics`."))
:type :integer
:visibility :internal
;; settable only through environmental variable
:setter :none
:getter (fn reading-prometheus-port-setting []
(let [parse (fn [raw-value]
(if-let [parsed (parse-long raw-value)]
parsed
(log/warn (trs "MB_PROMETHEUS_SERVER_PORT value of ''{0}'' is not parseable as an integer."
raw-value))))]
(setting/get-raw-value :prometheus-server-port integer? parse)))) | |
(p.types/defprotocol+ PrometheusActions (stop-web-server [this])) | |
(p/defrecord+ PrometheusSystem [registry web-server]
;; prometheus just runs in the background collecting metrics and serving them from
;; localhost:<prometheus-server-port>/metrics. Nothing we need to do but shutdown.
PrometheusActions
(stop-web-server [_this]
(when-let [^Server web-server web-server]
(.stop web-server)))) | |
Prometheus System for prometheus metrics | (defonce ^:private ^PrometheusSystem system nil) |
(declare setup-metrics! start-web-server!) | |
Takes a port (zero for a random port in test) and a registry name and returns a [[PrometheusSystem]] with a registry serving metrics from that port. | (defn- make-prometheus-system
[port registry-name]
(try
(let [registry (setup-metrics! registry-name)
web-server (start-web-server! port registry)]
(->PrometheusSystem registry web-server))
(catch Exception e
(throw (ex-info (trs "Failed to initialize Prometheus on port {0}" port)
{:port port}
e))))) |
Collectors | |
Takes | (defn c3p0-stats
[raw-stats]
(let [now (.toEpochMilli (java.time.Instant/now))
sample (fn sample [[db-label k v]]
{:name k
:value (double v)
:timestamp now
:label db-label})]
(->> raw-stats
(mapcat (fn [[db-label values]]
(map (fn [[k v]] [db-label k v]) values)))
(map sample)
(group-by :name)))) |
(def ^:private label-translation
{:maxPoolSize {:label "c3p0_max_pool_size"
:description (deferred-trs "C3P0 Max pool size")}
:minPoolSize {:label "c3p0_min_pool_size"
:description (deferred-trs "C3P0 Minimum pool size")}
:numConnections {:label "c3p0_num_connections"
:description (deferred-trs "C3P0 Number of connections")}
:numIdleConnections {:label "c3p0_num_idle_connections"
:description (deferred-trs "C3P0 Number of idle connections")}
:numBusyConnections {:label "c3p0_num_busy_connections"
:description (deferred-trs "C3P0 Number of busy connections")}
:numThreadsAwaitingCheckoutDefaultUser
{:label "c3p0_num_threads_awaiting_checkout_default_user"
:description (deferred-trs "C3P0 Number of threads awaiting checkout")}}) | |
Create an ArrayList of GaugeMetricFamily objects containing measurements from the c3p0 stats. Stats are grouped by
the property and the database information is attached as a label to multiple measurements of | (defn- stats->prometheus
[stats]
(let [arr (ArrayList. (count stats))]
(doseq [[raw-label measurements] stats]
(if-let [{gauge-label :label desc :description} (label-translation raw-label)]
(let [gauge (GaugeMetricFamily.
^String gauge-label
^String (str desc) ;; site-localized becomes string
(List/of "database"))]
(doseq [m measurements]
(.addMetric gauge (List/of (:label m)) (:value m)))
(.add arr gauge))
(log/warn (trs "Unrecognized measurement {0} in prometheus stats"
raw-label))))
arr)) |
(defn- conn-pool-bean-diag-info [acc ^ObjectName jmx-bean]
(let [bean-id (.getCanonicalName jmx-bean)
props [:numConnections :numIdleConnections :numBusyConnections
:minPoolSize :maxPoolSize :numThreadsAwaitingCheckoutDefaultUser]]
(assoc acc (jmx/read bean-id :dataSourceName) (jmx/read bean-id props)))) | |
Builds a map of info about the current c3p0 connection pools managed by this Metabase instance. | (defn connection-pool-info
[]
(reduce conn-pool-bean-diag-info {} (jmx/mbean-names "com.mchange.v2.c3p0:type=PooledDataSource,*"))) |
c3p0 collector delay | (def c3p0-collector
(letfn [(collect-metrics []
(-> (connection-pool-info)
c3p0-stats
stats->prometheus))]
(delay
(collector/named
{:name "c3p0-stats"
:namespace "metabase_database"}
(proxy [Collector] []
(collect
([] (collect-metrics))
([_sampleNameFilter] (collect-metrics)))))))) |
JVM collectors. Essentially duplicating [[iapetos.collector.jvm]] namespace so we can set our own namespaces rather than "iapetos_internal" | (defn- jvm-collectors
[]
[(collector/named {:namespace "metabase_application"
:name "jvm_gc"}
(GarbageCollectorExports.))
(collector/named {:namespace "metabase_application"
:name "jvm_standard"}
(StandardExports.))
(collector/named {:namespace "metabase_application"
:name "jvm_memory_pools"}
(MemoryPoolsExports.))
(collector/named {:namespace "metabase_application"
:name "jvm_threads"}
(ThreadExports.))]) |
(defn- jetty-collectors
[]
;; when in dev you might not have a server setup
(when (server/instance)
[(collector/named {:namespace "metabase_webserver"
:name "jetty_stats"}
(JettyStatisticsCollector. (.getHandler (server/instance))))])) | |
Instrument the application. Conditionally done when some setting is set. If [[prometheus-server-port]] is not set it will throw. | (defn- setup-metrics!
[registry-name]
(log/info (trs "Starting prometheus metrics collector"))
(let [registry (prometheus/collector-registry registry-name)]
(apply prometheus/register registry
(concat (jvm-collectors)
(jetty-collectors)
[@c3p0-collector]
; Iapetos will use "default" if we do not provide a namespace, so explicitly set `metabase-email`:
[(prometheus/counter :metabase-email/messages
{:description (trs "Number of emails sent.")})
(prometheus/counter :metabase-email/message-errors
{:description (trs "Number of errors when sending emails.")})])))) |
Start the prometheus web-server. If [[prometheus-server-port]] is not set it will throw. | (defn- start-web-server!
[port registry]
(log/info (trs "Starting prometheus metrics web-server on port {0}" (str port)))
(when-not port
(throw (ex-info (trs "Attempting to set up prometheus metrics web-server with no web-server port provided")
{})))
(ring-jetty/run-jetty (-> (constantly {:status 200})
(collector.ring/wrap-metrics registry {:path "/metrics"}))
{:join? false
:port port
:max-threads 8})) |
API: call [[setup!]] once, call [[shutdown!]] on shutdown | |
Start the prometheus metric collector and web-server. | (defn setup!
[]
(let [port (prometheus-server-port)]
(when-not port
(throw (ex-info (trs "Attempting to set up prometheus metrics with no web-server port provided")
{})))
(when-not system
(locking #'system
(when-not system
(let [sys (make-prometheus-system port "metabase-registry")]
(alter-var-root #'system (constantly sys)))))))) |
Stop the prometheus metrics web-server if it is running. | (defn shutdown!
[]
(when system
(locking #'system
(when system
(try (stop-web-server system)
(prometheus/clear (.-registry system))
(alter-var-root #'system (constantly nil))
(log/info (trs "Prometheus web-server shut down"))
(catch Exception e
(log/warn e (trs "Error stopping prometheus web-server")))))))) |
Call iapetos.core/inc on the metric in the global registry, if it has already been initialized and the metric is registered. | (defn inc [metric] (some-> system .-registry metric prometheus/inc)) |
(comment (require 'iapetos.export) (spit "metrics" (iapetos.export/text-format (.registry system)))) | |
Functions for sending Snowplow analytics events | (ns metabase.analytics.snowplow (:require [clojure.string :as str] [java-time.api :as t] [medley.core :as m] [metabase.config :as config] [metabase.models.setting :as setting :refer [defsetting Setting]] [metabase.models.user :refer [User]] [metabase.public-settings :as public-settings] [metabase.util.date-2 :as u.date] [metabase.util.i18n :refer [deferred-tru trs]] [metabase.util.log :as log] [toucan2.core :as t2]) (:import (com.snowplowanalytics.snowplow.tracker Snowplow Subject Tracker) (com.snowplowanalytics.snowplow.tracker.configuration EmitterConfiguration NetworkConfiguration SubjectConfiguration TrackerConfiguration) (com.snowplowanalytics.snowplow.tracker.events SelfDescribing SelfDescribing$Builder2) (com.snowplowanalytics.snowplow.tracker.http ApacheHttpClientAdapter) (com.snowplowanalytics.snowplow.tracker.payload SelfDescribingJson) (org.apache.http.client.config CookieSpecs RequestConfig) (org.apache.http.impl.client HttpClients) (org.apache.http.impl.conn PoolingHttpClientConnectionManager))) |
(set! *warn-on-reflection* true) | |
Adding or updating a Snowplow schema? Make sure that the two maps below are updated accordingly. | |
The most recent version for each event schema. This should be updated whenever a new version of a schema is added to SnowcatCloud, at the same time that the data sent to the collector is updated. | (def ^:private schema->version
{::account "1-0-1"
::invite "1-0-1"
::csvupload "1-0-0"
::dashboard "1-1-3"
::database "1-0-1"
::instance "1-1-2"
::metabot "1-0-1"
::search "1-0-1"
::model "1-0-0"
::timeline "1-0-0"
::task "1-0-0"
::action "1-0-0"
::embed_share "1-0-0"}) |
The schema to use for each analytics event. | (def ^:private event->schema
{::new-instance-created ::account
::new-user-created ::account
::invite-sent ::invite
::index-model-entities-enabled ::model
::dashboard-created ::dashboard
::question-added-to-dashboard ::dashboard
::dashboard-tab-created ::dashboard
::dashboard-tab-deleted ::dashboard
::database-connection-successful ::database
::database-connection-failed ::database
::new-event-created ::timeline
::new-task-history ::task
::new-search-query ::search
::search-results-filtered ::search
::action-created ::action
::action-updated ::action
::action-deleted ::action
::action-executed ::action
::csv-upload-successful ::csvupload
::csv-upload-failed ::csvupload
::metabot-feedback-received ::metabot
::embedding-enabled ::embed_share
::embedding-disabled ::embed_share}) |
(defsetting analytics-uuid
(deferred-tru
(str "Unique identifier to be used in Snowplow analytics, to identify this instance of Metabase. "
"This is a public setting since some analytics events are sent prior to initial setup."))
:visibility :public
:type :string
:setter :none
:init setting/random-uuid-str
:doc false) | |
(defsetting snowplow-available
(deferred-tru
(str "Boolean indicating whether a Snowplow collector is available to receive analytics events. "
"Should be set via environment variable in Cypress tests or during local development."))
:type :boolean
:visibility :public
:default config/is-prod?
:doc false
:audit :never) | |
(defsetting snowplow-enabled
(deferred-tru
(str "Boolean indicating whether analytics events are being sent to Snowplow. "
"True if anonymous tracking is enabled for this instance, and a Snowplow collector is available."))
:type :boolean
:setter :none
:getter (fn [] (and (snowplow-available)
(public-settings/anon-tracking-enabled)))
:visibility :public
:doc false) | |
(defsetting snowplow-url
(deferred-tru "The URL of the Snowplow collector to send analytics events to.")
:default (if config/is-prod?
"https://sp.metabase.com"
;; See the iglu-schema-registry repo for instructions on how to run Snowplow Micro locally for development
"http://localhost:9090")
:visibility :public
:audit :never
:doc false) | |
Returns the earliest user creation timestamp in the database | (defn- first-user-creation [] (:min (t2/select-one [User [:%min.date_joined :min]]))) |
We need to declare | (declare track-event!) |
(defsetting instance-creation
(deferred-tru "The approximate timestamp at which this instance of Metabase was created, for inclusion in analytics.")
:visibility :public
:setter :none
:getter (fn []
(when-not (t2/exists? Setting :key "instance-creation")
;; For instances that were started before this setting was added (in 0.41.3), use the creation
;; timestamp of the first user. For all new instances, use the timestamp at which this setting
;; is first read.
(let [value (or (first-user-creation) (t/offset-date-time))]
(setting/set-value-of-type! :timestamp :instance-creation value)
(track-event! ::new-instance-created)))
(u.date/format-rfc3339 (setting/get-value-of-type :timestamp :instance-creation)))
:doc false) | |
Returns instance of a Snowplow tracker config | (def ^:private tracker-config
(let [tracker-config* (delay (TrackerConfiguration. "sp" "metabase"))]
(fn [] @tracker-config*))) |
Returns instance of a Snowplow network config | (def ^:private network-config
(let [network-config* (delay
(let [request-config (-> (RequestConfig/custom)
;; Set cookie spec to `STANDARD` to avoid warnings about an invalid cookie
;; header in request response (PR #24579)
(.setCookieSpec CookieSpecs/STANDARD)
(.build))
client (-> (HttpClients/custom)
(.setConnectionManager (PoolingHttpClientConnectionManager.))
(.setDefaultRequestConfig request-config)
(.build))
http-client-adapter (ApacheHttpClientAdapter. (snowplow-url) client)]
(NetworkConfiguration. http-client-adapter)))]
(fn [] @network-config*))) |
Returns an instance of a Snowplow emitter config | (def ^:private emitter-config
(let [emitter-config* (delay (-> (EmitterConfiguration.)
(.batchSize 1)))]
(fn [] @emitter-config*))) |
Returns instance of a Snowplow tracker | (def ^:private tracker
(let [tracker* (delay
(Snowplow/createTracker
^TrackerConfiguration (tracker-config)
^NetworkConfiguration (network-config)
^EmitterConfiguration (emitter-config)))]
(fn [] @tracker*))) |
Create a Subject object for a given user ID, to be included in analytics events | (defn- subject
[user-id]
(Subject.
(-> (SubjectConfiguration.)
(.userId (str user-id))
;; Override with localhost IP to avoid logging actual user IP addresses
(.ipAddress "127.0.0.1")))) |
Returns the type of the Metabase application database as a string (e.g. PostgreSQL, MySQL) | (defn- app-db-type
[]
(t2/with-connection [^java.sql.Connection conn]
(.. conn getMetaData getDatabaseProductName))) |
Returns the version of the Metabase application database as a string | (defn- app-db-version
[]
(t2/with-connection [^java.sql.Connection conn]
(let [metadata (.getMetaData conn)]
(format "%d.%d" (.getDatabaseMajorVersion metadata) (.getDatabaseMinorVersion metadata))))) |
Common context included in every analytics event | (defn- context
[]
(new SelfDescribingJson
(str "iglu:com.metabase/instance/jsonschema/" (schema->version ::instance))
{"id" (analytics-uuid)
"version" {"tag" (:tag (public-settings/version))}
"token_features" (m/map-keys name (public-settings/token-features))
"created_at" (instance-creation)
"application_database" (app-db-type)
"application_database_version" (app-db-version)})) |
(defn- normalize-kw [kw] (-> kw name (str/replace #"-" "_"))) | |
A SelfDescribingJson object containing the provided event data, which can be included as the payload for an analytics event | (defn- payload
[schema version event-kw data]
(new SelfDescribingJson
(format "iglu:com.metabase/%s/jsonschema/%s" (normalize-kw schema) version)
;; Make sure keywords in payload are converted to strings in snake-case
(m/map-kv
(fn [k v] [(normalize-kw k) (if (keyword? v) (normalize-kw v) v)])
(assoc data :event event-kw)))) |
Wrapper function around the | (defn- track-event-impl! [tracker event] (.track ^Tracker tracker ^SelfDescribing event)) |
Send a single analytics event to the Snowplow collector, if tracking is enabled for this MB instance and a collector is available. | (defn track-event!
[event-kw & [user-id data]]
(when (snowplow-enabled)
(try
(let [schema (event->schema event-kw)
^SelfDescribing$Builder2 builder (-> (. SelfDescribing builder)
(.eventData (payload schema (schema->version schema) event-kw data))
(.customContext [(context)])
(cond-> user-id (.subject (subject user-id))))
^SelfDescribing event (.build builder)]
(track-event-impl! (tracker) event))
(catch Throwable e
(log/error e (trs "Error sending Snowplow analytics event {0}" event-kw)))))) |
Functions which summarize the usage of an instance | (ns metabase.analytics.stats
(:require
[cheshire.core :as json]
[clj-http.client :as http]
[clojure.string :as str]
[java-time.api :as t]
[medley.core :as m]
[metabase.analytics.snowplow :as snowplow]
[metabase.config :as config]
[metabase.db.query :as mdb.query]
[metabase.db.util :as mdb.u]
[metabase.driver :as driver]
[metabase.email :as email]
[metabase.embed.settings :as embed.settings]
[metabase.integrations.google :as google]
[metabase.integrations.slack :as slack]
[metabase.models
:refer [Card
Collection
Dashboard
DashboardCard
Database
Field
Metric
PermissionsGroup
Pulse
PulseCard
PulseChannel
QueryCache
Segment
Table
User]]
[metabase.models.humanization :as humanization]
[metabase.public-settings :as public-settings]
[metabase.util :as u]
[metabase.util.honey-sql-2 :as h2x]
[metabase.util.i18n :refer [trs]]
[metabase.util.log :as log]
[toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
Merge sequence of maps | (defn- merge-count-maps
[ms]
(reduce (partial merge-with +)
{}
(for [m ms]
(m/map-vals #(cond
(number? %) %
% 1
:else 0)
m)))) |
(def ^:private ^String metabase-usage-url "https://xuq0fbkk0j.execute-api.us-east-1.amazonaws.com/prod") | |
Return small bin number. Assumes positive inputs. | (defn- bin-small-number
[x]
(cond
(= 0 x) "0"
(<= 1 x 5) "1-5"
(<= 6 x 10) "6-10"
(<= 11 x 25) "11-25"
(> x 25) "25+")) |
Return medium bin number. Assumes positive inputs. | (defn- bin-medium-number
[x]
(cond
(= 0 x) "0"
(<= 1 x 5) "1-5"
(<= 6 x 10) "6-10"
(<= 11 x 25) "11-25"
(<= 26 x 50) "26-50"
(<= 51 x 100) "51-100"
(<= 101 x 250) "101-250"
(> x 250) "250+")) |
Return large bin number. Assumes positive inputs. | (defn- bin-large-number
[x]
(cond
(= 0 x) "0"
(< x 1) "< 1"
(<= 1 x 10) "1-10"
(<= 11 x 50) "11-50"
(<= 51 x 250) "51-250"
(<= 251 x 1000) "251-1000"
(<= 1001 x 10000) "1001-10000"
(> x 10000) "10000+")) |
Go through a bunch of maps and count the frequency a given key's values. | (defn- value-frequencies [many-maps k] (frequencies (map k many-maps))) |
Bin some frequencies using a passed in ;; Generate histogram for values of :a; ;; (or if you already have the counts) (histogram bin-micro-number [3 1 1]) ;; -> {"3+" 1, "1" 2} | (defn- histogram ([binning-fn counts] (frequencies (map binning-fn counts))) ([binning-fn many-maps k] (histogram binning-fn (vals (value-frequencies many-maps k))))) |
Return a histogram for medium numbers. | (def ^:private medium-histogram (partial histogram bin-medium-number)) |
Figure out what we're running under | (defn environment-type
[]
(cond
(config/config-str :rds-hostname) :elastic-beanstalk
(config/config-str :database-url) :heroku ;; Putting this last as 'database-url' seems least specific
:else :unknown)) |
(def ^:private ui-colors #{:brand :filter :summarize}) | |
Returns true if the 'User Interface Colors' have been customized | (defn appearance-ui-colors-changed? [] (boolean (seq (select-keys (public-settings/application-colors) ui-colors)))) |
Returns true if the 'Chart Colors' have been customized | (defn appearance-chart-colors-changed? [] (boolean (seq (apply dissoc (public-settings/application-colors) ui-colors)))) |
Figure out global info about this instance | (defn- instance-settings
[]
{:version (config/mb-version-info :tag)
:running_on (environment-type)
:startup_time_millis (public-settings/startup-time-millis)
:application_database (config/config-str :mb-db-type)
:check_for_updates (public-settings/check-for-updates)
:report_timezone (driver/report-timezone)
; We deprecated advanced humanization but have this here anyways
:friendly_names (= (humanization/humanization-strategy) "advanced")
:email_configured (email/email-configured?)
:slack_configured (slack/slack-configured?)
:sso_configured (google/google-auth-enabled)
:instance_started (snowplow/instance-creation)
:has_sample_data (t2/exists? Database, :is_sample true)
:enable_embedding (embed.settings/enable-embedding)
:embedding_app_origin_set (boolean (embed.settings/embedding-app-origin))
:appearance_site_name (not= (public-settings/site-name) "Metabase")
:appearance_help_link (public-settings/help-link)
:appearance_logo (not= (public-settings/application-logo-url) "app/assets/img/logo.svg")
:appareance_favicon (not= (public-settings/application-favicon-url) "app/assets/img/favicon.ico")
:apperance_loading_message (not= (public-settings/loading-message) :doing-science)
:appearance_metabot_greeting (not (public-settings/show-metabot))
:apparerance_lighthouse_illustration (not (public-settings/show-lighthouse-illustration))
:appearance_ui_colors (appearance-ui-colors-changed?)
:appearance_chart_colors (appearance-chart-colors-changed?)
:appearance_show_mb_links (not (public-settings/show-metabase-links))}) |
Get metrics based on user records. TODO: get activity in terms of created questions, pulses and dashboards | (defn- user-metrics
[]
{:users (merge-count-maps (for [user (t2/select [User :is_active :is_superuser :last_login :sso_source]
:type :personal)]
{:total 1
:active (:is_active user)
:admin (:is_superuser user)
:logged_in (:last_login user)
:sso (= :google (:sso_source user))}))}) |
Get metrics based on groups: TODO characterize by # w/ sql access, # of users, no self-serve data access | (defn- group-metrics
[]
{:groups (t2/count PermissionsGroup)}) |
(defn- card-has-params? [card] (boolean (get-in card [:dataset_query :native :template-tags]))) | |
Get metrics based on questions TODO characterize by # executions and avg latency | (defn- question-metrics
[]
(let [cards (t2/select [Card :query_type :public_uuid :enable_embedding :embedding_params :dataset_query])]
{:questions (merge-count-maps (for [card cards]
(let [native? (= (keyword (:query_type card)) :native)]
{:total 1
:native native?
:gui (not native?)
:with_params (card-has-params? card)})))
:public (merge-count-maps (for [card cards
:when (:public_uuid card)]
{:total 1
:with_params (card-has-params? card)}))
:embedded (merge-count-maps (for [card cards
:when (:enable_embedding card)]
(let [embedding-params-vals (set (vals (:embedding_params card)))]
{:total 1
:with_params (card-has-params? card)
:with_enabled_params (contains? embedding-params-vals "enabled")
:with_locked_params (contains? embedding-params-vals "locked")
:with_disabled_params (contains? embedding-params-vals "disabled")})))})) |
Get metrics based on dashboards TODO characterize by # of revisions, and created by an admin | (defn- dashboard-metrics
[]
(let [dashboards (t2/select [Dashboard :creator_id :public_uuid :parameters :enable_embedding :embedding_params])
dashcards (t2/select [DashboardCard :card_id :dashboard_id])]
{:dashboards (count dashboards)
:with_params (count (filter (comp seq :parameters) dashboards))
:num_dashs_per_user (medium-histogram dashboards :creator_id)
:num_cards_per_dash (medium-histogram dashcards :dashboard_id)
:num_dashs_per_card (medium-histogram dashcards :card_id)
:public (merge-count-maps (for [dash dashboards
:when (:public_uuid dash)]
{:total 1
:with_params (seq (:parameters dash))}))
:embedded (merge-count-maps (for [dash dashboards
:when (:enable_embedding dash)]
(let [embedding-params-vals (set (vals (:embedding_params dash)))]
{:total 1
:with_params (seq (:parameters dash))
:with_enabled_params (contains? embedding-params-vals "enabled")
:with_locked_params (contains? embedding-params-vals "locked")
:with_disabled_params (contains? embedding-params-vals "disabled")})))})) |
Fetch the frequencies of a given (db-frequencies Database :engine) ;; -> {"h2" 2, "postgres" 1, ...} ;; include ;; Generate a histogram: (micro-histogram (vals (db-frequencies Database :engine))) ;; -> {"2" 1, "1" 1, ...} ;; Include | (defn- db-frequencies
{:style/indent 2}
[model column & [additonal-honeysql]]
(into {} (for [{:keys [k count]} (t2/select [model [column :k] [:%count.* :count]]
(merge {:group-by [column]}
additonal-honeysql))]
[k count]))) |
Return the number of Notifications that satisfy ;; Pulses only (filter out Alerts) (num-notifications-with-xls-or-csv-cards [:= :alert_condition nil]) | (defn- num-notifications-with-xls-or-csv-cards
[& where-conditions]
(-> (mdb.query/query {:select [[[::h2x/distinct-count :pulse.id] :count]]
:from [:pulse]
:left-join [:pulse_card [:= :pulse.id :pulse_card.pulse_id]]
:where (into
[:and
[:or
[:= :pulse_card.include_csv true]
[:= :pulse_card.include_xls true]]]
where-conditions)})
first
:count)) |
Get metrics based on pulses TODO: characterize by non-user account emails, # emails | (defn- pulse-metrics
[]
(let [pulse-conditions {:left-join [:pulse [:= :pulse.id :pulse_id]], :where [:= :pulse.alert_condition nil]}]
{:pulses (t2/count Pulse :alert_condition nil)
;; "Table Cards" are Cards that include a Table you can download
:with_table_cards (num-notifications-with-xls-or-csv-cards [:= :alert_condition nil])
:pulse_types (db-frequencies PulseChannel :channel_type pulse-conditions)
:pulse_schedules (db-frequencies PulseChannel :schedule_type pulse-conditions)
:num_pulses_per_user (medium-histogram (vals (db-frequencies Pulse :creator_id (dissoc pulse-conditions :left-join))))
:num_pulses_per_card (medium-histogram (vals (db-frequencies PulseCard :card_id pulse-conditions)))
:num_cards_per_pulses (medium-histogram (vals (db-frequencies PulseCard :pulse_id pulse-conditions)))})) |
(defn- alert-metrics []
(let [alert-conditions {:left-join [:pulse [:= :pulse.id :pulse_id]], :where [:not= (mdb.u/qualify Pulse :alert_condition) nil]}]
{:alerts (t2/count Pulse :alert_condition [:not= nil])
:with_table_cards (num-notifications-with-xls-or-csv-cards [:not= :alert_condition nil])
:first_time_only (t2/count Pulse :alert_condition [:not= nil], :alert_first_only true)
:above_goal (t2/count Pulse :alert_condition [:not= nil], :alert_above_goal true)
:alert_types (db-frequencies PulseChannel :channel_type alert-conditions)
:num_alerts_per_user (medium-histogram (vals (db-frequencies Pulse :creator_id (dissoc alert-conditions :left-join))))
:num_alerts_per_card (medium-histogram (vals (db-frequencies PulseCard :card_id alert-conditions)))
:num_cards_per_alerts (medium-histogram (vals (db-frequencies PulseCard :pulse_id alert-conditions)))})) | |
Get metrics on Collection usage. | (defn- collection-metrics
[]
(let [collections (t2/select Collection)
cards (t2/select [Card :collection_id])]
{:collections (count collections)
:cards_in_collections (count (filter :collection_id cards))
:cards_not_in_collections (count (remove :collection_id cards))
:num_cards_per_collection (medium-histogram cards :collection_id)})) |
Get metrics based on Databases. Metadata Metrics | (defn- database-metrics
[]
(let [databases (t2/select [Database :is_full_sync :engine :dbms_version])]
{:databases (merge-count-maps (for [{is-full-sync? :is_full_sync} databases]
{:total 1
:analyzed is-full-sync?}))
:dbms_versions (frequencies (map (fn [db]
(-> db
:dbms_version
(assoc :engine (:engine db))
json/generate-string))
databases))})) |
Get metrics based on Tables. | (defn- table-metrics
[]
(let [tables (t2/select [Table :db_id :schema])]
{:tables (count tables)
:num_per_database (medium-histogram tables :db_id)
:num_per_schema (medium-histogram tables :schema)})) |
Get metrics based on Fields. | (defn- field-metrics
[]
(let [fields (t2/select [Field :table_id])]
{:fields (count fields)
:num_per_table (medium-histogram fields :table_id)})) |
Get metrics based on Segments. | (defn- segment-metrics
[]
{:segments (t2/count Segment)}) |
Get metrics based on Metrics. | (defn- metric-metrics
[]
{:metrics (t2/count Metric)}) |
Execution Metrics | |
Summarize | (defn summarize-executions
([]
(summarize-executions (t2/reducible-select [:model/QueryExecution :executor_id :running_time :error])))
([executions]
(reduce summarize-executions {:executions 0, :by_status {}, :num_per_user {}, :num_by_latency {}} executions))
([summary execution]
(-> summary
(update :executions u/safe-inc)
(update-in [:by_status (if (:error execution)
"failed"
"completed")] u/safe-inc)
(update-in [:num_per_user (:executor_id execution)] u/safe-inc)
(update-in [:num_by_latency (bin-large-number (/ (:running_time execution) 1000))] u/safe-inc)))) |
Convert a map of | (defn- summarize-executions-per-user [user-id->num-executions] (frequencies (map bin-large-number (vals user-id->num-executions)))) |
Get metrics based on QueryExecutions. | (defn- execution-metrics
[]
(-> (summarize-executions)
(update :num_per_user summarize-executions-per-user))) |
Cache Metrics | |
Metrics based on use of the QueryCache. | (defn- cache-metrics
[]
(let [{:keys [length count]} (t2/select-one [QueryCache [[:avg [:length :results]] :length] [:%count.* :count]])]
{:average_entry_size (int (or length 0))
:num_queries_cached (bin-small-number count)})) |
System Metrics | |
(defn- bytes->megabytes [b] (Math/round (double (/ b 1024 1024)))) | |
(def ^:private system-property-names ["java.version" "java.vm.specification.version" "java.runtime.name" "user.timezone" "user.language" "user.country" "file.encoding" "os.name" "os.version"]) | |
Metadata about the environment Metabase is running in | (defn- system-metrics
[]
(let [runtime (Runtime/getRuntime)]
(merge
{:max_memory (bytes->megabytes (.maxMemory runtime))
:processors (.availableProcessors runtime)}
(zipmap (map #(keyword (str/replace % \. \_)) system-property-names)
(map #(System/getProperty %) system-property-names))))) |
Combined Stats & Logic for sending them in | |
generate a map of the usage stats for this instance | (defn anonymous-usage-stats
[]
(merge (instance-settings)
{:uuid (public-settings/site-uuid)
:timestamp (t/offset-date-time)
:stats {:cache (cache-metrics)
:collection (collection-metrics)
:dashboard (dashboard-metrics)
:database (database-metrics)
:execution (execution-metrics)
:field (field-metrics)
:group (group-metrics)
:metric (metric-metrics)
:pulse (pulse-metrics)
:alert (alert-metrics)
:question (question-metrics)
:segment (segment-metrics)
:system (system-metrics)
:table (table-metrics)
:user (user-metrics)}})) |
send stats to Metabase tracking server | (defn- send-stats!
[stats]
(try
(http/post metabase-usage-url {:form-params stats, :content-type :json, :throw-entire-message? true})
(catch Throwable e
(log/error e (trs "Sending usage stats FAILED"))))) |
Collect usage stats and phone them home | (defn phone-home-stats!
[]
(when (public-settings/anon-tracking-enabled)
(send-stats! (anonymous-usage-stats)))) |
| (ns metabase.api.action (:require [cheshire.core :as json] [compojure.core :as compojure :refer [POST]] [metabase.actions :as actions] [metabase.actions.execution :as actions.execution] [metabase.actions.http-action :as http-action] [metabase.analytics.snowplow :as snowplow] [metabase.api.common :as api] [metabase.api.common.validation :as validation] [metabase.models :refer [Action Card Database]] [metabase.models.action :as action] [metabase.models.card :as card] [metabase.models.collection :as collection] [metabase.util :as u] [metabase.util.i18n :refer [deferred-tru tru]] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
(def ^:private json-query-schema
[:and
string?
(mu/with-api-error-message
[:fn #(http-action/apply-json-query {} %)]
(deferred-tru "must be a valid json-query, something like ''.item.title''"))]) | |
(def ^:private supported-action-type
(mu/with-api-error-message
[:enum "http" "query" "implicit"]
(deferred-tru "Unsupported action type"))) | |
(def ^:private implicit-action-kind
(mu/with-api-error-message
(into [:enum]
(for [ns ["row" "bulk"]
action ["create" "update" "delete"]]
(str ns "/" action)))
(deferred-tru "Unsupported implicit action kind"))) | |
(def ^:private http-action-template
[:map {:closed true}
[:method [:enum "GET" "POST" "PUT" "DELETE" "PATCH"]]
[:url [string? {:min 1}]]
[:body {:optional true} [:maybe string?]]
[:headers {:optional true} [:maybe string?]]
[:parameters {:optional true} [:maybe [:sequential map?]]]
[:parameter_mappings {:optional true} [:maybe map?]]]) | |
/ | (api/defendpoint GET
"Returns actions that can be used for QueryActions. By default lists all viewable actions. Pass optional
`?model-id=<model-id>` to limit to actions on a particular model."
[model-id]
{model-id [:maybe ms/PositiveInt]}
(letfn [(actions-for [models]
(if (seq models)
(t2/hydrate (action/select-actions models
:model_id [:in (map :id models)]
:archived false)
:creator)
[]))]
;; We don't check the permissions on the actions, we assume they are readable if the model is readable.
(let [models (if model-id
[(api/read-check Card model-id)]
(t2/select Card {:where
[:and
[:= :dataset true]
[:= :archived false]
;; action permission keyed off of model permission
(collection/visible-collection-ids->honeysql-filter-clause
:collection_id
(collection/permissions-set->visible-collection-ids
@api/*current-user-permissions-set*))]}))]
(actions-for models)))) |
/public | (api/defendpoint GET "Fetch a list of Actions with public UUIDs. These actions are publicly-accessible *if* public sharing is enabled." [] (validation/check-has-application-permission :setting) (validation/check-public-sharing-enabled) (t2/select [Action :name :id :public_uuid :model_id], :public_uuid [:not= nil], :archived false)) |
/:action-id | (api/defendpoint GET
[action-id]
{action-id ms/PositiveInt}
(-> (action/select-action :id action-id :archived false)
(t2/hydrate :creator)
api/read-check)) |
/:action-id | (api/defendpoint DELETE
[action-id]
{action-id ms/PositiveInt}
(let [action (api/write-check Action action-id)]
(snowplow/track-event! ::snowplow/action-deleted api/*current-user-id* {:type (:type action)
:action_id action-id}))
(t2/delete! Action :id action-id)
api/generic-204-no-content) |
/ | (api/defendpoint POST
"Create a new action."
[:as {{:keys [type name description model_id parameters parameter_mappings visualization_settings
kind
database_id dataset_query
template response_handle error_handle] :as action} :body}]
{name :string
model_id ms/PositiveInt
type [:maybe supported-action-type]
description [:maybe :string]
parameters [:maybe [:sequential map?]]
parameter_mappings [:maybe map?]
visualization_settings [:maybe map?]
kind [:maybe implicit-action-kind]
database_id [:maybe ms/PositiveInt]
dataset_query [:maybe map?]
template [:maybe http-action-template]
response_handle [:maybe json-query-schema]
error_handle [:maybe json-query-schema]}
(when (and (nil? database_id)
(= "query" type))
(throw (ex-info (tru "Must provide a database_id for query actions")
{:type type
:status-code 400})))
(let [model (api/write-check Card model_id)]
(when (and (= "implicit" type)
(not (card/model-supports-implicit-actions? model)))
(throw (ex-info (tru "Implicit actions are not supported for models with clauses.")
{:status-code 400})))
(doseq [db-id (cond-> [(:database_id model)] database_id (conj database_id))]
(actions/check-actions-enabled-for-database!
(t2/select-one Database :id db-id))))
(let [action-id (action/insert! (assoc action :creator_id api/*current-user-id*))]
(snowplow/track-event! ::snowplow/action-created api/*current-user-id* {:type type
:action_id action-id
:num_parameters (count parameters)})
(if action-id
(action/select-action :id action-id)
;; t2/insert! does not return a value when used with h2
;; so we return the most recently updated http action.
(last (action/select-actions nil :type type))))) |
/:id | (api/defendpoint PUT
[id :as {action :body}]
{id ms/PositiveInt
action [:map
[:archived {:optional true} [:maybe :boolean]]
[:database_id {:optional true} [:maybe ms/PositiveInt]]
[:dataset_query {:optional true} [:maybe :map]]
[:description {:optional true} [:maybe :string]]
[:error_handle {:optional true} [:maybe json-query-schema]]
[:kind {:optional true} [:maybe implicit-action-kind]]
[:model_id {:optional true} [:maybe ms/PositiveInt]]
[:name {:optional true} [:maybe :string]]
[:parameter_mappings {:optional true} [:maybe :map]]
[:parameters {:optional true} [:maybe [:sequential :map]]]
[:response_handle {:optional true} [:maybe json-query-schema]]
[:template {:optional true} [:maybe http-action-template]]
[:type {:optional true} [:maybe supported-action-type]]
[:visualization_settings {:optional true} [:maybe :map]]]}
(actions/check-actions-enabled! id)
(let [existing-action (api/write-check Action id)]
(action/update! (assoc action :id id) existing-action))
(let [{:keys [parameters type] :as action} (action/select-action :id id)]
(snowplow/track-event! ::snowplow/action-updated api/*current-user-id* {:type type
:action_id id
:num_parameters (count parameters)})
action)) |
/:id/public_link | (api/defendpoint POST
"Generate publicly-accessible links for this Action. Returns UUID to be used in public links. (If this
Action has already been shared, it will return the existing public link rather than creating a new one.) Public
sharing must be enabled."
[id]
{id ms/PositiveInt}
(api/check-superuser)
(validation/check-public-sharing-enabled)
(let [action (api/read-check Action id :archived false)]
(actions/check-actions-enabled! action)
{:uuid (or (:public_uuid action)
(u/prog1 (str (random-uuid))
(t2/update! Action id
{:public_uuid <>
:made_public_by_id api/*current-user-id*})))})) |
/:id/public_link | (api/defendpoint DELETE
"Delete the publicly-accessible link to this Dashboard."
[id]
{id ms/PositiveInt}
;; check the /application/setting permission, not superuser because removing a public link is possible from /admin/settings
(validation/check-has-application-permission :setting)
(validation/check-public-sharing-enabled)
(api/check-exists? Action :id id, :public_uuid [:not= nil], :archived false)
(actions/check-actions-enabled! id)
(t2/update! Action id {:public_uuid nil, :made_public_by_id nil})
{:status 204, :body nil}) |
/:action-id/execute | (api/defendpoint GET
"Fetches the values for filling in execution parameters. Pass PK parameters and values to select."
[action-id parameters]
{action-id ms/PositiveInt
parameters ms/JSONString}
(actions/check-actions-enabled! action-id)
(-> (action/select-action :id action-id :archived false)
api/read-check
(actions.execution/fetch-values (json/parse-string parameters)))) |
/:id/execute | (api/defendpoint POST
"Execute the Action.
`parameters` should be the mapped dashboard parameters with values."
[id :as {{:keys [parameters], :as _body} :body}]
{id ms/PositiveInt
parameters [:maybe [:map-of :keyword any?]]}
(let [{:keys [type] :as action} (api/check-404 (action/select-action :id id :archived false))]
(snowplow/track-event! ::snowplow/action-executed api/*current-user-id* {:source :model_detail
:type type
:action_id id})
(actions.execution/execute-action! action (update-keys parameters name)))) |
(api/define-routes) | |
(ns metabase.api.activity (:require [clojure.string :as str] [compojure.core :refer [GET]] [medley.core :as m] [metabase.api.common :as api :refer [*current-user-id* define-routes]] [metabase.db.util :as mdb.u] [metabase.models.card :refer [Card]] [metabase.models.dashboard :refer [Dashboard]] [metabase.models.interface :as mi] [metabase.models.query-execution :refer [QueryExecution]] [metabase.models.recent-views :as recent-views] [metabase.models.table :refer [Table]] [metabase.models.view-log :refer [ViewLog]] [metabase.util.honey-sql-2 :as h2x] [toucan2.core :as t2])) | |
(defn- models-query
[model ids]
(t2/select
(case model
"card" [Card
:id :name :collection_id :description :display
:dataset_query :dataset :archived
:collection.authority_level]
"dashboard" [Dashboard
:id :name :collection_id :description
:archived
:collection.authority_level]
"table" [Table
:id :name :db_id
:display_name :initial_sync_status
:visibility_type])
(let [model-symb (symbol (str/capitalize model))
self-qualify #(mdb.u/qualify model-symb %)]
(cond-> {:where [:in (self-qualify :id) ids]}
(not= model "table")
(merge {:left-join [:collection [:= :collection.id (self-qualify :collection_id)]]}))))) | |
(defn- select-items! [model ids]
(when (seq ids)
(for [model (t2/hydrate (models-query model ids) :moderation_reviews)
:let [reviews (:moderation_reviews model)
status (->> reviews
(filter :most_recent)
first
:status)]]
(assoc model :moderated_status status)))) | |
Returns a map of {model {id instance}} for activity views suitable for looking up by model and id to get a model. | (defn- models-for-views
[views]
(into {} (map (fn [[model models]]
[model (->> models
(map :model_id)
(select-items! model)
(m/index-by :id))]))
(group-by :model views))) |
Query implementation for The expected output of the query is a single row per unique model viewed by the current user including a Viewing a Dashboard will add entries to the view log for all cards on that dashboard so all card views are instead derived
from the query_execution table. The query context is always a | (defn- views-and-runs
[views-limit card-runs-limit all-users?]
;; TODO update to use RecentViews instead of ViewLog
(let [dashboard-and-table-views (t2/select [ViewLog
[[:min :view_log.user_id] :user_id]
:model
:model_id
[:%count.* :cnt]
[:%max.timestamp :max_ts]]
{:group-by [:model :model_id]
:where [:and
(when-not all-users? [:= (mdb.u/qualify ViewLog :user_id) *current-user-id*])
[:in :model #{"dashboard" "table"}]
[:= :bm.id nil]]
:order-by [[:max_ts :desc] [:model :desc]]
:limit views-limit
:left-join [[:dashboard_bookmark :bm]
[:and
[:= :model "dashboard"]
[:= :bm.user_id *current-user-id*]
[:= :model_id :bm.dashboard_id]]]})
card-runs (->> (t2/select [QueryExecution
[:%min.executor_id :user_id]
[(mdb.u/qualify QueryExecution :card_id) :model_id]
[:%count.* :cnt]
[:%max.started_at :max_ts]]
{:group-by [(mdb.u/qualify QueryExecution :card_id) :context]
:where [:and
(when-not all-users? [:= :executor_id *current-user-id*])
[:= :context (h2x/literal :question)]
[:= :bm.id nil]]
:order-by [[:max_ts :desc]]
:limit card-runs-limit
:left-join [[:card_bookmark :bm]
[:and
[:= :bm.user_id *current-user-id*]
[:= (mdb.u/qualify QueryExecution :card_id) :bm.card_id]]]})
(map #(dissoc % :row_count))
(map #(assoc % :model "card")))]
(->> (concat card-runs dashboard-and-table-views)
(sort-by :max_ts)
reverse))) |
(def ^:private views-limit 8) (def ^:private card-runs-limit 8) | |
/recent_views | (api/defendpoint GET
"Get a list of 5 things the current user has been viewing most recently."
[]
(let [views (recent-views/user-recent-views api/*current-user-id* 10)
model->id->items (models-for-views views)]
(->> (for [{:keys [model model_id] :as view-log} views
:let
[model-object (-> (get-in model->id->items [model model_id])
(dissoc :dataset_query))]
:when
(and model-object
(mi/can-read? model-object)
;; hidden tables, archived cards/dashboards
(not (or (:archived model-object)
(= (:visibility_type model-object) :hidden))))]
(cond-> (assoc view-log :model_object model-object)
(:dataset model-object) (assoc :model "dataset")))
(take 5)))) |
/mostrecentlyviewed_dashboard | (api/defendpoint GET
"Get the most recently viewed dashboard for the current user. Returns a 204 if the user has not viewed any dashboards
in the last 24 hours."
[]
(if-let [dashboard-id (recent-views/most-recently-viewed-dashboard-id api/*current-user-id*)]
(let [dashboard (-> (t2/select-one Dashboard :id dashboard-id)
api/check-404
(t2/hydrate [:collection :is_personal]))]
(if (mi/can-read? dashboard)
dashboard
api/generic-204-no-content))
api/generic-204-no-content)) |
Returns true if the item belongs to an official collection. False otherwise. Assumes that | (defn- official?
[{:keys [authority_level]}]
(boolean
(when authority_level
(#{"official"} authority_level)))) |
Return true if the item is verified, false otherwise. Assumes that | (defn- verified?
[{:keys [moderated_status]}]
(= moderated_status "verified")) |
(defn- score-items
[items]
(when (seq items)
(let [n-items (count items)
max-count (apply max (map :cnt items))]
(for [[recency-pos {:keys [cnt model_object] :as item}] (zipmap (range) items)]
(let [verified-wt 1
official-wt 1
recency-wt 2
views-wt 4
scores [;; cards and dashboards? can be 'verified' in enterprise
(if (verified? model_object) verified-wt 0)
;; items may exist in an 'official' collection in enterprise
(if (official? model_object) official-wt 0)
;; most recent item = 1 * recency-wt, least recent item of 10 items = 1/10 * recency-wt
(* (/ (- n-items recency-pos) n-items) recency-wt)
;; item with highest count = 1 * views-wt, lowest = item-view-count / max-view-count * views-wt
;; NOTE: the query implementation `views-and-runs` has an order-by clause using most recent timestamp
;; this has an effect on the outcomes. Consider an item with a massively high viewcount but a last view by the user
;; a long time ago. This may not even make it into the firs 10 items from the query, even though it might be worth showing
(* (/ cnt max-count) views-wt)]]
(assoc item :score (double (reduce + scores)))))))) | |
(def ^:private model-precedence ["dashboard" "card" "dataset" "table"]) | |
(defn- order-items
[items]
(when (seq items)
(let [groups (group-by :model items)]
(mapcat #(get groups %) model-precedence)))) | |
/popular_items | (api/defendpoint GET
"Get the list of 5 popular things for the current user. Query takes 8 and limits to 5 so that if it
finds anything archived, deleted, etc it can usually still get 5."
[]
;; we can do a weighted score which incorporates:
;; total count -> higher = higher score
;; recently viewed -> more recent = higher score
;; official/verified -> yes = higher score
(let [views (views-and-runs views-limit card-runs-limit true)
model->id->items (models-for-views views)
filtered-views (for [{:keys [model model_id] :as view-log} views
:let [model-object (-> (get-in model->id->items [model model_id])
(dissoc :dataset_query))]
:when (and model-object
(mi/can-read? model-object)
;; hidden tables, archived cards/dashboards
(not (or (:archived model-object)
(= (:visibility_type model-object) :hidden))))]
(cond-> (assoc view-log :model_object model-object)
(:dataset model-object) (assoc :model "dataset")))
scored-views (score-items filtered-views)]
(->> scored-views
(sort-by :score)
reverse
order-items
(take 5)
(map #(dissoc % :score))))) |
(define-routes) | |
/api/alert endpoints | (ns metabase.api.alert (:require [clojure.data :as data] [clojure.set :refer [difference]] [compojure.core :refer [DELETE GET POST PUT]] [medley.core :as m] [metabase.api.common :as api] [metabase.api.common.validation :as validation] [metabase.config :as config] [metabase.email :as email] [metabase.email.messages :as messages] [metabase.events :as events] [metabase.models.card :refer [Card]] [metabase.models.interface :as mi] [metabase.models.pulse :as pulse] [metabase.models.pulse-channel :refer [PulseChannel]] [metabase.models.pulse-channel-recipient :refer [PulseChannelRecipient]] [metabase.plugins.classloader :as classloader] [metabase.public-settings.premium-features :as premium-features] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
(when config/ee-available? (classloader/require 'metabase-enterprise.advanced-permissions.common)) | |
/ | (api/defendpoint GET
"Fetch alerts which the current user has created or will receive, or all alerts if the user is an admin.
The optional `user_id` will return alerts created by the corresponding user, but is ignored for non-admin users."
[archived user_id]
{archived [:maybe ms/BooleanString]
user_id [:maybe ms/PositiveInt]}
(let [user-id (if api/*is-superuser?*
user_id
api/*current-user-id*)]
(as-> (pulse/retrieve-alerts {:archived? (Boolean/parseBoolean archived)
:user-id user-id}) <>
(filter mi/can-read? <>)
(t2/hydrate <> :can_write)))) |
/:id | (api/defendpoint GET
"Fetch an alert by ID"
[id]
{id ms/PositiveInt}
(-> (api/read-check (pulse/retrieve-alert id))
(t2/hydrate :can_write))) |
/question/:id | (api/defendpoint GET
"Fetch all alerts for the given question (`Card`) id"
[id archived]
{id [:maybe ms/PositiveInt]
archived [:maybe ms/BooleanString]}
(-> (if api/*is-superuser?*
(pulse/retrieve-alerts-for-cards {:card-ids [id], :archived? (Boolean/parseBoolean archived)})
(pulse/retrieve-user-alerts-for-card {:card-id id, :user-id api/*current-user-id*, :archived? (Boolean/parseBoolean archived)}))
(t2/hydrate :can_write))) |
(defn- only-alert-keys [request]
(u/select-keys-when request
:present [:alert_condition :alert_first_only :alert_above_goal :archived])) | |
Get email channel from an alert. | (defn email-channel [alert] (m/find-first #(= :email (keyword (:channel_type %))) (:channels alert))) |
Get slack channel from an alert. | (defn- slack-channel [alert] (m/find-first #(= :slack (keyword (:channel_type %))) (:channels alert))) |
(defn- key-by [key-fn coll] (zipmap (map key-fn coll) coll)) | |
(defn- notify-email-disabled! [alert recipients]
(doseq [user recipients]
(messages/send-admin-unsubscribed-alert-email! alert user @api/*current-user*))) | |
(defn- notify-email-enabled! [alert recipients]
(doseq [user recipients]
(messages/send-you-were-added-alert-email! alert user @api/*current-user*))) | |
(defn- notify-email-recipient-diffs! [old-alert old-recipients new-alert new-recipients]
(let [old-ids->users (key-by :id old-recipients)
new-ids->users (key-by :id new-recipients)
[removed-ids added-ids _] (data/diff (set (keys old-ids->users))
(set (keys new-ids->users)))]
(doseq [old-id removed-ids
:let [removed-user (get old-ids->users old-id)]]
(messages/send-admin-unsubscribed-alert-email! old-alert removed-user @api/*current-user*))
(doseq [new-id added-ids
:let [added-user (get new-ids->users new-id)]]
(messages/send-you-were-added-alert-email! new-alert added-user @api/*current-user*)))) | |
This function compares | (defn- notify-recipient-changes!
[old-alert updated-alert]
(let [{old-recipients :recipients, old-enabled :enabled} (email-channel old-alert)
{new-recipients :recipients, new-enabled :enabled} (email-channel updated-alert)]
(cond
;; Did email notifications just get disabled?
(and old-enabled (not new-enabled))
(notify-email-disabled! old-alert old-recipients)
;; Did a disabled email notifications just get re-enabled?
(and (not old-enabled) new-enabled)
(notify-email-enabled! updated-alert new-recipients)
;; No need to notify recipients if emails are disabled
new-enabled
(notify-email-recipient-diffs! old-alert old-recipients updated-alert new-recipients)))) |
(defn- collect-alert-recipients [alert] (set (:recipients (email-channel alert)))) | |
(defn- non-creator-recipients [{{creator-id :id} :creator :as alert}]
(remove #(= creator-id (:id %)) (collect-alert-recipients alert))) | |
(defn- notify-new-alert-created! [alert]
(when (email/email-configured?)
(messages/send-new-alert-email! alert)
(doseq [recipient (non-creator-recipients alert)]
(messages/send-you-were-added-alert-email! alert recipient @api/*current-user*)))) | |
(defn- maybe-include-csv [card alert-condition]
(if (= "rows" alert-condition)
(assoc card :include_csv true)
card)) | |
/ | (api/defendpoint POST
"Create a new Alert."
[:as {{:keys [alert_condition card channels alert_first_only alert_above_goal]
:as new-alert-request-body} :body}]
{alert_condition pulse/AlertConditions
alert_first_only :boolean
alert_above_goal [:maybe :boolean]
card pulse/CardRef
channels [:+ :map]}
(validation/check-has-application-permission :subscription false)
;; To create an Alert you need read perms for its Card
(api/read-check Card (u/the-id card))
;; ok, now create the Alert
(let [alert-card (-> card (maybe-include-csv alert_condition) pulse/card->ref)
new-alert (api/check-500
(-> new-alert-request-body
only-alert-keys
(pulse/create-alert! api/*current-user-id* alert-card channels)))]
(events/publish-event! :event/alert-create {:object new-alert :user-id api/*current-user-id*})
(notify-new-alert-created! new-alert)
;; return our new Alert
new-alert)) |
When an alert is archived, we notify all recipients that they are no longer receiving that alert. | (defn- notify-on-archive-if-needed!
[alert]
(when (email/email-configured?)
(doseq [recipient (collect-alert-recipients alert)]
(messages/send-admin-unsubscribed-alert-email! alert recipient @api/*current-user*)))) |
/:id | (api/defendpoint PUT
"Update a `Alert` with ID."
[id :as {{:keys [alert_condition alert_first_only alert_above_goal card channels archived]
:as alert-updates} :body}]
{id ms/PositiveInt
alert_condition [:maybe pulse/AlertConditions]
alert_first_only [:maybe :boolean]
alert_above_goal [:maybe :boolean]
card [:maybe pulse/CardRef]
channels [:maybe [:+ [:map]]]
archived [:maybe :boolean]}
(try
(validation/check-has-application-permission :monitoring)
(catch clojure.lang.ExceptionInfo _e
(validation/check-has-application-permission :subscription false)))
;; fetch the existing Alert in the DB
(let [alert-before-update (api/check-404 (pulse/retrieve-alert id))
current-user-has-application-permissions? (and (premium-features/enable-advanced-permissions?)
(resolve 'metabase-enterprise.advanced-permissions.common/current-user-has-application-permissions?))
has-subscription-perms? (and current-user-has-application-permissions?
(current-user-has-application-permissions? :subscription))
has-monitoring-permissions? (and current-user-has-application-permissions?
(current-user-has-application-permissions? :monitoring))]
(assert (:card alert-before-update)
(tru "Invalid Alert: Alert does not have a Card associated with it"))
;; check permissions as needed.
;; Check permissions to update existing Card
(api/read-check Card (u/the-id (:card alert-before-update)))
;; if trying to change the card, check perms for that as well
(when card
(api/write-check Card (u/the-id card)))
(when-not (or api/*is-superuser?*
has-monitoring-permissions?
has-subscription-perms?)
(api/check (= (-> alert-before-update :creator :id) api/*current-user-id*)
[403 (tru "Non-admin users without monitoring or subscription permissions are only allowed to update alerts that they created")])
(api/check (or (not (contains? alert-updates :channels))
(and (= 1 (count channels))
;; Non-admin alerts can only include the creator as a recipient
(= [api/*current-user-id*]
(map :id (:recipients (email-channel alert-updates))))))
[403 (tru "Non-admin users without monitoring or subscription permissions are not allowed to modify the channels for an alert")]))
;; only admin or users with subscription permissions can add recipients
(let [to-add-recipients (difference (set (map :id (:recipients (email-channel alert-updates))))
(set (map :id (:recipients (email-channel alert-before-update)))))]
(api/check (or api/*is-superuser?*
has-subscription-perms?
(empty? to-add-recipients))
[403 (tru "Non-admin users without subscription permissions are not allowed to add recipients")]))
;; now update the Alert
(let [updated-alert (pulse/update-alert!
(merge
(assoc (only-alert-keys alert-updates)
:id id)
(when card
{:card (pulse/card->ref card)})
(when (contains? alert-updates :channels)
{:channels channels})
;; automatically archive alert if it now has no recipients
(when (and (contains? alert-updates :channels)
(not (seq (:recipients (email-channel alert-updates))))
(not (slack-channel alert-updates)))
{:archived true})))]
;; Only admins or users has subscription or monitoring perms
;; can update recipients or explicitly archive an alert
(when (and (or api/*is-superuser?*
has-subscription-perms?
has-monitoring-permissions?)
(email/email-configured?))
(if archived
(notify-on-archive-if-needed! updated-alert)
(notify-recipient-changes! alert-before-update updated-alert)))
;; Finally, return the updated Alert
updated-alert))) |
/:id/subscription | (api/defendpoint DELETE
"For users to unsubscribe themselves from the given alert."
[id]
{id ms/PositiveInt}
(validation/check-has-application-permission :subscription false)
(let [alert (pulse/retrieve-alert id)]
(api/read-check alert)
(api/let-404 [alert-id (u/the-id alert)
pc-id (t2/select-one-pk PulseChannel :pulse_id alert-id :channel_type "email")
pcr-id (t2/select-one-pk PulseChannelRecipient :pulse_channel_id pc-id :user_id api/*current-user-id*)]
(t2/delete! PulseChannelRecipient :id pcr-id))
;; Send emails letting people know they have been unsubscribed
(let [user @api/*current-user*]
(when (email/email-configured?)
(messages/send-you-unsubscribed-alert-email! alert user))
(events/publish-event! :event/alert-unsubscribe {:object {:email (:email user)}
:user-id api/*current-user-id*}))
;; finally, return a 204 No Content
api/generic-204-no-content)) |
(api/define-routes) | |
/api/api-key endpoints for CRUD management of API Keys | (ns metabase.api.api-key (:require [compojure.core :refer [POST GET PUT DELETE]] [metabase.api.common :as api] [metabase.events :as events] [metabase.models.api-key :as api-key] [metabase.models.permissions-group :as perms-group] [metabase.models.user :as user] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.malli.schema :as ms] [metabase.util.secret :as u.secret] [toucan2.core :as t2])) |
(defn- maybe-expose-key [api-key]
(if (contains? api-key :unmasked_key)
(update api-key :unmasked_key u.secret/expose)
api-key)) | |
Takes an ApiKey and hydrates/selects keys as necessary to put it into a standard form for responses | (defn- present-api-key
[api-key]
(-> api-key
(t2/hydrate :group :updated_by)
(select-keys [:created_at
:updated_at
:updated_by
:id
:group
:unmasked_key
:name
:masked_key])
(maybe-expose-key)
(update :updated_by #(select-keys % [:common_name :id])))) |
(defn- key-with-unique-prefix []
(u/auto-retry 5
(let [api-key (api-key/generate-key)
prefix (api-key/prefix (u.secret/expose api-key))]
;; we could make this more efficient by generating 5 API keys up front and doing one select to remove any
;; duplicates. But a duplicate should be rare enough to just do multiple queries for now.
(if-not (t2/exists? :model/ApiKey :key_prefix prefix)
api-key
(throw (ex-info (tru "could not generate key with unique prefix") {})))))) | |
(defn- with-updated-by [api-key] (assoc api-key :updated_by_id api/*current-user-id*)) | |
(defn- with-creator [api-key] (assoc api-key :creator_id api/*current-user-id*)) | |
/ | (api/defendpoint POST
"Create a new API key (and an associated `User`) with the provided name and group ID."
[:as {{:keys [group_id name] :as _body} :body}]
{group_id ms/PositiveInt
name ms/NonBlankString}
(api/check-superuser)
(api/checkp (not (t2/exists? :model/ApiKey :name name))
"name" "An API key with this name already exists.")
(let [unhashed-key (key-with-unique-prefix)
email (format "api-key-user-%s@api-key.invalid" (random-uuid))]
(t2/with-transaction [_conn]
(let [user (first
(t2/insert-returning-instances! :model/User
{:email email
:first_name name
:last_name ""
:type :api-key
:password (str (random-uuid))}))]
(user/set-permissions-groups! user [(perms-group/all-users) group_id])
(let [api-key (-> (t2/insert-returning-instance! :model/ApiKey
(-> {:user_id (u/the-id user)
:name name
:unhashed_key unhashed-key}
with-creator
with-updated-by))
(t2/hydrate :group :updated_by))]
(events/publish-event! :event/api-key-create
{:object api-key
:user-id api/*current-user-id*})
(present-api-key (assoc api-key :unmasked_key unhashed-key))))))) |
/count | (api/defendpoint GET "Get the count of API keys in the DB" [:as _body] (api/check-superuser) (t2/count :model/ApiKey)) |
/:id | (api/defendpoint PUT
"Update an API key by changing its group and/or its name"
[id :as {{:keys [group_id name] :as _body} :body}]
{id ms/PositiveInt
group_id [:maybe ms/PositiveInt]
name [:maybe ms/NonBlankString]}
(api/check-superuser)
(let [api-key-before (-> (t2/select-one :model/ApiKey :id id)
;; hydrate the group_name for audit logging
(t2/hydrate :group)
(api/check-404))]
(t2/with-transaction [_conn]
(when group_id
(let [user (-> api-key-before (t2/hydrate :user) :user)]
(user/set-permissions-groups! user [(perms-group/all-users) {:id group_id}])))
(when name
;; A bit of a pain to keep these in sync, but oh well.
(t2/update! :model/User (:user_id api-key-before) {:first_name name
:last_name ""})
(t2/update! :model/ApiKey id (with-updated-by {:name name}))))
(let [updated-api-key (-> (t2/select-one :model/ApiKey :id id)
(t2/hydrate :group :updated_by))]
(events/publish-event! :event/api-key-update {:object updated-api-key
:previous-object api-key-before
:user-id api/*current-user-id*})
(present-api-key updated-api-key)))) |
/:id/regenerate | (api/defendpoint PUT
"Regenerate an API Key"
[id]
{id ms/PositiveInt}
(api/check-superuser)
(let [api-key-before (-> (t2/select-one :model/ApiKey id)
(t2/hydrate :group)
(api/check-404))
unhashed-key (key-with-unique-prefix)
api-key-after (assoc api-key-before
:unhashed_key unhashed-key
:key_prefix (api-key/prefix (u.secret/expose unhashed-key)))]
(t2/update! :model/ApiKey :id id (with-updated-by
(select-keys api-key-after [:unhashed_key])))
(events/publish-event! :event/api-key-regenerate
{:object api-key-after
:previous-object api-key-before
:user-id api/*current-user-id*})
(present-api-key (assoc api-key-after
:unmasked_key unhashed-key
:masked_key (api-key/mask unhashed-key))))) |
/ | (api/defendpoint GET
"Get a list of API keys. Non-paginated."
[]
(api/check-superuser)
(let [api-keys (t2/hydrate (t2/select :model/ApiKey) :group :updated_by)]
(map present-api-key api-keys))) |
/:id | (api/defendpoint DELETE
"Delete an ApiKey"
[id]
{id ms/PositiveInt}
(api/check-superuser)
(let [api-key (-> (t2/select-one :model/ApiKey id)
(t2/hydrate :group)
(api/check-404))]
(t2/with-transaction [_tx]
(t2/delete! :model/ApiKey id)
(t2/update! :model/User (:user_id api-key) {:is_active false}))
(events/publish-event! :event/api-key-delete
{:object api-key
:user-id api/*current-user-id*})
api/generic-204-no-content)) |
(api/define-routes) | |
(ns metabase.api.automagic-dashboards
(:require
[buddy.core.codecs :as codecs]
[cheshire.core :as json]
[compojure.core :refer [GET]]
[metabase.api.common :as api]
[metabase.automagic-dashboards.comparison :refer [comparison-dashboard]]
[metabase.automagic-dashboards.core :as magic
:refer [automagic-analysis candidate-tables]]
[metabase.automagic-dashboards.dashboard-templates :as dashboard-templates]
[metabase.models.card :refer [Card]]
[metabase.models.collection :refer [Collection]]
[metabase.models.database :refer [Database]]
[metabase.models.field :refer [Field]]
[metabase.models.metric :refer [Metric]]
[metabase.models.model-index :refer [ModelIndex ModelIndexValue]]
[metabase.models.permissions :as perms]
[metabase.models.query :as query]
[metabase.models.query.permissions :as query-perms]
[metabase.models.segment :refer [Segment]]
[metabase.models.table :refer [Table]]
[metabase.transforms.dashboard :as transform.dashboard]
[metabase.transforms.materialize :as tf.materialize]
[metabase.util.i18n :refer [deferred-tru]]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[ring.util.codec :as codec]
[toucan2.core :as t2])) | |
(set! *warn-on-reflection* true) | |
(def ^:private Show
(mu/with-api-error-message
[:maybe [:or [:enum "all"] nat-int?]]
(deferred-tru "invalid show value"))) | |
(def ^:private Prefix
(mu/with-api-error-message
[:fn (fn [prefix]
(some #(not-empty (dashboard-templates/get-dashboard-templates [% prefix])) ["table" "metric" "field"]))]
(deferred-tru "invalid value for prefix"))) | |
(def ^:private DashboardTemplate
(mu/with-api-error-message
[:fn (fn [dashboard-template]
(some (fn [toplevel]
(some (comp dashboard-templates/get-dashboard-template
(fn [prefix]
[toplevel prefix dashboard-template])
:dashboard-template-name)
(dashboard-templates/get-dashboard-templates [toplevel])))
["table" "metric" "field"]))]
(deferred-tru "invalid value for dashboard template name"))) | |
(def ^:private ^{:arglists '([s])} decode-base64-json
(comp #(json/decode % keyword) codecs/bytes->str codec/base64-decode)) | |
(def ^:private Base64EncodedJSON
(mu/with-api-error-message
[:fn decode-base64-json]
(deferred-tru "value couldn''t be parsed as base64 encoded JSON"))) | |
/database/:id/candidates | (api/defendpoint GET
"Return a list of candidates for automagic dashboards orderd by interestingness."
[id]
{id ms/PositiveInt}
(-> (t2/select-one Database :id id)
api/read-check
candidate-tables)) |
----------------------------------------- API Endpoints for viewing a transient dashboard ---------------- | |
(defn- adhoc-query-read-check
[query]
(api/check-403 (perms/set-has-partial-permissions-for-set?
@api/*current-user-permissions-set*
(query-perms/perms-set (:dataset_query query), :throw-exceptions? true)))
query) | |
(defn- ensure-int
[x]
(if (string? x)
(Integer/parseInt x)
x)) | |
Parse/decode/coerce string | (defmulti ^:private ->entity
{:arglists '([entity-type s])}
(fn [entity-type _s]
(keyword entity-type))) |
(defmethod ->entity :table
[_entity-type table-id-str]
;; table-id can also be a source query reference like `card__1` so in that case we should pull the ID out and use the
;; `:question` method instead
(if-let [[_ card-id-str] (when (string? table-id-str)
(re-matches #"^card__(\d+$)" table-id-str))]
(->entity :question card-id-str)
(api/read-check (t2/select-one Table :id (ensure-int table-id-str))))) | |
(defmethod ->entity :segment [_entity-type segment-id-str] (api/read-check (t2/select-one Segment :id (ensure-int segment-id-str)))) | |
(defmethod ->entity :model
[_entity-type card-id-str]
(api/read-check (t2/select-one Card
:id (ensure-int card-id-str)
:dataset true))) | |
(defmethod ->entity :question [_entity-type card-id-str] (api/read-check (t2/select-one Card :id (ensure-int card-id-str)))) | |
(defmethod ->entity :adhoc [_entity-type encoded-query] (adhoc-query-read-check (query/adhoc-query (decode-base64-json encoded-query)))) | |
(defmethod ->entity :metric [_entity-type metric-id-str] (api/read-check (t2/select-one Metric :id (ensure-int metric-id-str)))) | |
(defmethod ->entity :field [_entity-type field-id-str] (api/read-check (t2/select-one Field :id (ensure-int field-id-str)))) | |
(defmethod ->entity :transform [_entity-type transform-name] (api/read-check (t2/select-one Collection :id (tf.materialize/get-collection transform-name))) transform-name) | |
(def ^:private entities (map name (keys (methods ->entity)))) | |
(def ^:private Entity
(mu/with-api-error-message
(into [:enum] entities)
(deferred-tru "Invalid entity type"))) | |
(def ^:private ComparisonEntity
(mu/with-api-error-message
[:enum "segment" "adhoc" "table"]
(deferred-tru "Invalid comparison entity type. Can only be one of \"table\", \"segment\", or \"adhoc\))) | |
Show is either nil, "all", or a number. If it's a string it needs to be converted into a keyword. | (defn- coerce-show [show] (cond-> show (= "all" show) keyword)) |
/:entity/:entity-id-or-query | (api/defendpoint GET
"Return an automagic dashboard for entity `entity` with id `id`."
[entity entity-id-or-query show]
{show [:maybe [:or [:= "all"] nat-int?]]
entity (mu/with-api-error-message
(into [:enum] entities)
(deferred-tru "Invalid entity type"))}
(if (= entity "transform")
(transform.dashboard/dashboard (->entity entity entity-id-or-query))
(-> (->entity entity entity-id-or-query)
(automagic-analysis {:show (coerce-show show)})))) |
Identify the pk field of the model with | (defn linked-entities
[{{field-ref :pk_ref} :model-index {rsmd :result_metadata} :model}]
(when-let [field-id (:id (some #(when ((comp #{field-ref} :field_ref) %) %) rsmd))]
(map
(fn [{:keys [table_id id]}]
{:linked-table-id table_id
:linked-field-id id})
(t2/select 'Field :fk_target_field_id field-id)))) |
Insert a source model link card into the sequence of passed in cards. | (defn- add-source-model-link
[{model-name :name model-id :id} cards]
(let [max-width (->> (map (fn [{:keys [col size_x]}] (+ col size_x)) cards)
(into [4])
(apply max))]
(cons
{:id (gensym)
:size_x max-width
:size_y 1
:row 0
:col 0
:visualization_settings {:virtual_card {:display "link"
:archived false},
:link {:entity {:id model-id
:name model-name
:model "dataset"
:display "table"
:description nil}}}}
cards))) |
For each joinable table from | (defn- create-linked-dashboard
[{{indexed-entity-name :name :keys [model_pk]} :model-index-value
{model-name :name :as model} :model
:keys [linked-tables]}]
(if (seq linked-tables)
(let [child-dashboards (map (fn [{:keys [linked-table-id linked-field-id]}]
(let [table (t2/select-one Table :id linked-table-id)]
(magic/automagic-analysis
table
{:show :all
:query-filter [:= [:field linked-field-id nil] model_pk]})))
linked-tables)
seed-dashboard (-> (first child-dashboards)
(merge
{:name (format "Here's a look at \"%s\" from \"%s\"" indexed-entity-name model-name)
:description (format "A dashboard focusing on information linked to %s" indexed-entity-name)
:parameters []
:param_fields {}})
(dissoc :transient_name
:transient_filters))]
(if (second child-dashboards)
(->> child-dashboards
(map-indexed (fn [idx {tab-name :name tab-cards :dashcards}]
;; id starts at 0. want our temporary ids to start at -1, -2, ...
(let [tab-id (dec (- idx))]
{:tab {:id tab-id
:name tab-name
:position idx}
:dash-cards
(map (fn [dc]
(assoc dc :dashboard_tab_id tab-id))
(add-source-model-link model tab-cards))})))
(reduce (fn [dashboard {:keys [tab dash-cards]}]
(-> dashboard
(update :dashcards into dash-cards)
(update :tabs conj tab)))
(merge
seed-dashboard
{:dashcards []
:tabs []})))
(update seed-dashboard
:dashcards (fn [cards] (add-source-model-link model cards)))))
{:name (format "Here's a look at \"%s\" from \"%s\"" indexed-entity-name model-name)
:dashcards (add-source-model-link
model
[{:row 0
:col 0
:size_x 18
:size_y 2
:visualization_settings {:text "# Unfortunately, there's not much else to show right now..."
:virtual_card {:display :text}
:dashcard.background false
:text.align_vertical :bottom}}])})) |
/modelindex/:model-index-id/primarykey/:pk-id | (api/defendpoint GET
"Return an automagic dashboard for an entity detail specified by `entity`
with id `id` and a primary key of `indexed-value`."
[model-index-id pk-id]
{model-index-id :int
pk-id :int}
(api/let-404 [model-index (t2/select-one ModelIndex model-index-id)
model (t2/select-one Card (:model_id model-index))
model-index-value (t2/select-one ModelIndexValue
:model_index_id model-index-id
:model_pk pk-id)]
;; `->entity` does a read check on the model but this is here as well to be extra sure.
(api/read-check Card (:model_id model-index))
(let [linked (linked-entities {:model model
:model-index model-index
:model-index-value model-index-value})]
(create-linked-dashboard {:model model
:linked-tables linked
:model-index model-index
:model-index-value model-index-value})))) |
/:entity/:entity-id-or-query/rule/:prefix/:dashboard-template | (api/defendpoint GET
"Return an automagic dashboard for entity `entity` with id `id` using dashboard-template `dashboard-template`."
[entity entity-id-or-query prefix dashboard-template show]
{entity Entity
show Show
prefix Prefix
dashboard-template DashboardTemplate}
(-> (->entity entity entity-id-or-query)
(automagic-analysis {:show (coerce-show show)
:dashboard-template ["table" prefix dashboard-template]}))) |
/:entity/:entity-id-or-query/cell/:cell-query | (api/defendpoint GET
"Return an automagic dashboard analyzing cell in automagic dashboard for entity `entity`
defined by
query `cell-query`."
[entity entity-id-or-query cell-query show]
{entity Entity
show Show
cell-query Base64EncodedJSON}
(-> (->entity entity entity-id-or-query)
(automagic-analysis {:show (coerce-show show)
:cell-query (decode-base64-json cell-query)}))) |
/:entity/:entity-id-or-query/cell/:cell-query/rule/:prefix/:dashboard-template | (api/defendpoint GET
"Return an automagic dashboard analyzing cell in question with id `id` defined by
query `cell-query` using dashboard-template `dashboard-template`."
[entity entity-id-or-query cell-query prefix dashboard-template show]
{entity Entity
show Show
prefix Prefix
dashboard-template DashboardTemplate
cell-query Base64EncodedJSON}
(-> (->entity entity entity-id-or-query)
(automagic-analysis {:show (coerce-show show)
:dashboard-template ["table" prefix dashboard-template]
:cell-query (decode-base64-json cell-query)}))) |
/:entity/:entity-id-or-query/compare/:comparison-entity/:comparison-entity-id-or-query | (api/defendpoint GET
"Return an automagic comparison dashboard for entity `entity` with id `id` compared with entity
`comparison-entity` with id `comparison-entity-id-or-query.`"
[entity entity-id-or-query show comparison-entity comparison-entity-id-or-query]
{show Show
entity Entity
comparison-entity ComparisonEntity}
(let [left (->entity entity entity-id-or-query)
right (->entity comparison-entity comparison-entity-id-or-query)
dashboard (automagic-analysis left {:show (coerce-show show)
:query-filter nil
:comparison? true})]
(comparison-dashboard dashboard left right {}))) |
/:entity/:entity-id-or-query/rule/:prefix/:dashboard-template/compare/:comparison-entity/:comparison-entity-id-or-query | (api/defendpoint GET
"Return an automagic comparison dashboard for entity `entity` with id `id` using dashboard-template `dashboard-template`;
compared with entity `comparison-entity` with id `comparison-entity-id-or-query.`."
[entity entity-id-or-query prefix dashboard-template show comparison-entity comparison-entity-id-or-query]
{entity Entity
show Show
prefix Prefix
dashboard-template DashboardTemplate
comparison-entity ComparisonEntity}
(let [left (->entity entity entity-id-or-query)
right (->entity comparison-entity comparison-entity-id-or-query)
dashboard (automagic-analysis left {:show (coerce-show show)
:dashboard-template ["table" prefix dashboard-template]
:query-filter nil
:comparison? true})]
(comparison-dashboard dashboard left right {}))) |
/:entity/:entity-id-or-query/cell/:cell-query/compare/:comparison-entity/:comparison-entity-id-or-query | (api/defendpoint GET
"Return an automagic comparison dashboard for cell in automagic dashboard for entity `entity`
with id `id` defined by query `cell-query`; compared with entity `comparison-entity` with id
`comparison-entity-id-or-query.`."
[entity entity-id-or-query cell-query show comparison-entity comparison-entity-id-or-query]
{entity Entity
show Show
cell-query Base64EncodedJSON
comparison-entity ComparisonEntity}
(let [left (->entity entity entity-id-or-query)
right (->entity comparison-entity comparison-entity-id-or-query)
dashboard (automagic-analysis left {:show (coerce-show show)
:query-filter nil
:comparison? true})]
(comparison-dashboard dashboard left right {:left {:cell-query (decode-base64-json cell-query)}}))) |
/:entity/:entity-id-or-query/cell/:cell-query/rule/:prefix/:dashboard-template/compare/:comparison-entity/:comparison-entity-id-or-query | (api/defendpoint GET
"Return an automagic comparison dashboard for cell in automagic dashboard for entity `entity`
with id `id` defined by query `cell-query` using dashboard-template `dashboard-template`; compared with entity
`comparison-entity` with id `comparison-entity-id-or-query.`."
[entity entity-id-or-query cell-query prefix dashboard-template show comparison-entity comparison-entity-id-or-query]
{entity Entity
show Show
prefix Prefix
dashboard-template DashboardTemplate
cell-query Base64EncodedJSON
comparison-entity ComparisonEntity}
(let [left (->entity entity entity-id-or-query)
right (->entity comparison-entity comparison-entity-id-or-query)
dashboard (automagic-analysis left {:show (coerce-show show)
:dashboard-template ["table" prefix dashboard-template]
:query-filter nil})]
(comparison-dashboard dashboard left right {:left {:cell-query (decode-base64-json cell-query)}}))) |
(api/define-routes) | |
Handle creating bookmarks for the user. Bookmarks are in three tables and should be thought of as a tuple of (model, model-id) rather than a row in a table with an id. The DELETE takes the model and id because DELETE's do not necessarily support request bodies. The POST is therefore shaped in this same manner. Since there are three underlying tables the id on the actual bookmark itself is not unique among "bookmarks" and is not a good identifier for using in the API. | (ns metabase.api.bookmark
(:require
[compojure.core :refer [DELETE GET POST]]
[metabase.api.common :as api]
[metabase.models.bookmark
:as bookmark
:refer [CardBookmark CollectionBookmark DashboardBookmark]]
[metabase.models.card :refer [Card]]
[metabase.models.collection :refer [Collection]]
[metabase.models.dashboard :refer [Dashboard]]
[metabase.util.malli.schema :as ms]
[toucan2.core :as t2])) |
Schema enumerating bookmarkable models. | (def Models (into [:enum] ["card" "dashboard" "collection"])) |
Schema for an ordered of boomark orderings | (def BookmarkOrderings
[:sequential [:map
[:type Models]
[:item_id ms/PositiveInt]]]) |
Lookup map from model as a string to [model bookmark-model item-id-key]. | (def ^:private lookup
{"card" [Card CardBookmark :card_id]
"dashboard" [Dashboard DashboardBookmark :dashboard_id]
"collection" [Collection CollectionBookmark :collection_id]}) |
/ | (api/defendpoint GET "Fetch all bookmarks for the user" [] ;; already sorted by created_at in query. Can optionally use user sort preferences here and not in the function ;; below (bookmark/bookmarks-for-user api/*current-user-id*)) |
/:model/:id | (api/defendpoint POST
"Create a new bookmark for user."
[model id]
{model Models
id ms/PositiveInt}
(let [[item-model bookmark-model item-key] (lookup model)]
(api/read-check item-model id)
(api/check (not (t2/exists? bookmark-model item-key id
:user_id api/*current-user-id*))
[400 "Bookmark already exists"])
(first (t2/insert-returning-instances! bookmark-model {item-key id :user_id api/*current-user-id*})))) |
/:model/:id | (api/defendpoint DELETE
"Delete a bookmark. Will delete a bookmark assigned to the user making the request by model and id."
[model id]
{model Models
id ms/PositiveInt}
;; todo: allow admins to include an optional user id to delete for so they can delete other's bookmarks.
(let [[_ bookmark-model item-key] (lookup model)]
(t2/delete! bookmark-model
:user_id api/*current-user-id*
item-key id)
api/generic-204-no-content)) |
/ordering | (api/defendpoint PUT
"Sets the order of bookmarks for user."
[:as {{:keys [orderings]} :body}]
{orderings BookmarkOrderings}
(bookmark/save-ordering! api/*current-user-id* orderings)
api/generic-204-no-content) |
(api/define-routes) | |
/api/card endpoints. | (ns metabase.api.card
(:require
[cheshire.core :as json]
[clojure.core.async :as a]
[clojure.java.io :as io]
[compojure.core :refer [DELETE GET POST PUT]]
[medley.core :as m]
[metabase.api.common :as api]
[metabase.api.common.validation :as validation]
[metabase.api.dataset :as api.dataset]
[metabase.api.field :as api.field]
[metabase.driver :as driver]
[metabase.events :as events]
[metabase.lib.types.isa :as lib.types.isa]
[metabase.mbql.normalize :as mbql.normalize]
[metabase.mbql.util :as mbql.u]
[metabase.models
:refer [Card CardBookmark Collection Database PersistedInfo Table]]
[metabase.models.card :as card]
[metabase.models.collection :as collection]
[metabase.models.collection.root :as collection.root]
[metabase.models.interface :as mi]
[metabase.models.params :as params]
[metabase.models.params.custom-values :as custom-values]
[metabase.models.persisted-info :as persisted-info]
[metabase.models.query :as query]
[metabase.models.query.permissions :as query-perms]
[metabase.models.revision.last-edit :as last-edit]
[metabase.models.timeline :as timeline]
[metabase.public-settings :as public-settings]
[metabase.public-settings.premium-features :as premium-features]
[metabase.query-processor.card :as qp.card]
[metabase.query-processor.pivot :as qp.pivot]
[metabase.related :as related]
[metabase.server.middleware.offset-paging :as mw.offset-paging]
[metabase.sync.analyze.query-results :as qr]
[metabase.task.persist-refresh :as task.persist-refresh]
[metabase.upload :as upload]
[metabase.util :as u]
[metabase.util.date-2 :as u.date]
[metabase.util.i18n :refer [deferred-tru trs tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[steffan-westcott.clj-otel.api.trace.span :as span]
[toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
----------------------------------------------- Filtered Fetch Fns ----------------------------------------------- | |
(defmulti ^:private cards-for-filter-option*
{:arglists '([filter-option & args])}
(fn [filter-option & _]
(keyword filter-option))) | |
return all Cards. This is the default filter option. | (defmethod cards-for-filter-option* :all
[_]
(t2/select Card, :archived false, {:order-by [[:%lower.name :asc]]})) |
return Cards created by the current user | (defmethod cards-for-filter-option* :mine
[_]
(t2/select Card, :creator_id api/*current-user-id*, :archived false, {:order-by [[:%lower.name :asc]]})) |
return all Cards bookmarked by the current user. | (defmethod cards-for-filter-option* :bookmarked
[_]
(let [cards (for [{{:keys [archived], :as card} :card} (t2/hydrate (t2/select [CardBookmark :card_id]
:user_id api/*current-user-id*)
:card)
:when (not archived)]
card)]
(sort-by :name cards))) |
Return all Cards belonging to Database with | (defmethod cards-for-filter-option* :database
[_ database-id]
(t2/select Card, :database_id database-id, :archived false, {:order-by [[:%lower.name :asc]]})) |
Return all Cards belonging to | (defmethod cards-for-filter-option* :table
[_ table-id]
(t2/select Card, :table_id table-id, :archived false, {:order-by [[:%lower.name :asc]]})) |
Cards that have been archived. | (defmethod cards-for-filter-option* :archived
[_]
(t2/select Card, :archived true, {:order-by [[:%lower.name :asc]]})) |
Cards that are using a given model. | (defmethod cards-for-filter-option* :using_model
[_filter-option model-id]
(->> (t2/select Card {:select [:c.*]
:from [[:report_card :m]]
:join [[:report_card :c] [:and
[:= :c.database_id :m.database_id]
[:or
[:like :c.dataset_query (format "%%card__%s%%" model-id)]
[:like :c.dataset_query (format "%%#%s%%" model-id)]]]]
:where [:and [:= :m.id model-id] [:not :c.archived]]})
;; now check if model-id really occurs as a card ID
(filter (fn [card] (some #{model-id} (-> card :dataset_query query/collect-card-ids)))))) |
(defn- cards-for-filter-option [filter-option model-id-or-nil]
(-> (apply cards-for-filter-option* filter-option (when model-id-or-nil [model-id-or-nil]))
(t2/hydrate :creator :collection))) | |
a valid card filter option. -------------------------------------------- Fetching a Card or Cards -------------------------------------------- | (def ^:private card-filter-options (map name (keys (methods cards-for-filter-option*)))) |
/ | (api/defendpoint GET
"Get all the Cards. Option filter param `f` can be used to change the set of Cards that are returned; default is
`all`, but other options include `mine`, `bookmarked`, `database`, `table`, `using_model` and `archived`. See
corresponding implementation functions above for the specific behavior of each filterp option. :card_index:"
[f model_id]
{f [:maybe (into [:enum] card-filter-options)]
model_id [:maybe ms/PositiveInt]}
(let [f (or (keyword f) :all)]
(when (contains? #{:database :table :using_model} f)
(api/checkp (integer? model_id) "model_id" (format "model_id is a required parameter when filter mode is '%s'"
(name f)))
(case f
:database (api/read-check Database model_id)
:table (api/read-check Database (t2/select-one-fn :db_id Table, :id model_id))
:using_model (api/read-check Card model_id)))
(let [cards (filter mi/can-read? (cards-for-filter-option f model_id))
last-edit-info (:card (last-edit/fetch-last-edited-info {:card-ids (map :id cards)}))]
(into []
(map (fn [{:keys [id] :as card}]
(if-let [edit-info (get last-edit-info id)]
(assoc card :last-edit-info edit-info)
card)))
cards)))) |
Adds additional information to a | (defn hydrate-card-details
[{card-id :id :as card}]
(span/with-span!
{:name "hydrate-card-details"
:attributes {:card/id card-id}}
(-> card
(t2/hydrate :creator
:dashboard_count
:can_write
:average_query_time
:last_query_start
:parameter_usage_count
[:collection :is_personal]
[:moderation_reviews :moderator_details])
(cond-> ; card
(:dataset card) (t2/hydrate :persisted))))) |
/:id | (api/defendpoint GET
"Get `Card` with ID."
[id ignore_view]
{id ms/PositiveInt
ignore_view [:maybe :boolean]}
(let [raw-card (t2/select-one Card :id id)
card (-> raw-card
api/read-check
hydrate-card-details
;; Cal 2023-11-27: why is last-edit-info hydrated differently for GET vs PUT and POST
(last-edit/with-last-edit-info :card)
collection.root/hydrate-root-collection)]
(u/prog1 card
(when-not ignore_view
(events/publish-event! :event/card-read {:object <> :user-id api/*current-user-id*}))))) |
(defn- card-columns-from-names
[card names]
(when-let [names (set names)]
(filter #(names (:name %)) (:result_metadata card)))) | |
(defn- cols->kebab-case [cols] (map #(update-keys % u/->kebab-case-en) cols)) | |
(defn- area-bar-line-series-are-compatible?
[first-card second-card]
(and (#{:area :line :bar} (:display second-card))
(let [initial-dimensions (cols->kebab-case
(card-columns-from-names
first-card
(get-in first-card [:visualization_settings :graph.dimensions])))
new-dimensions (cols->kebab-case
(card-columns-from-names
second-card
(get-in second-card [:visualization_settings :graph.dimensions])))
new-metrics (cols->kebab-case
(card-columns-from-names
second-card
(get-in second-card [:visualization_settings :graph.metrics])))]
(cond
;; must have at least one dimension and one metric
(or (zero? (count new-dimensions))
(zero? (count new-metrics)))
false
;; all metrics must be numeric
(not (every? lib.types.isa/numeric? new-metrics))
false
;; both or neither primary dimension must be dates
(not= (lib.types.isa/temporal? (first initial-dimensions))
(lib.types.isa/temporal? (first new-dimensions)))
false
;; both or neither primary dimension must be numeric
;; a timestamp field is both date and number so don't enforce the condition if both fields are dates; see #2811
(and (not= (lib.types.isa/numeric? (first initial-dimensions))
(lib.types.isa/numeric? (first new-dimensions)))
(not (and
(lib.types.isa/temporal? (first initial-dimensions))
(lib.types.isa/temporal? (first new-dimensions)))))
false
:else true)))) | |
Check if the | (defmulti series-are-compatible? (fn [card _second-card] (:display card))) |
(defmethod series-are-compatible? :area [first-card second-card] (area-bar-line-series-are-compatible? first-card second-card)) | |
(defmethod series-are-compatible? :line [first-card second-card] (area-bar-line-series-are-compatible? first-card second-card)) | |
(defmethod series-are-compatible? :bar [first-card second-card] (area-bar-line-series-are-compatible? first-card second-card)) | |
(defmethod series-are-compatible? :scalar
[first-card second-card]
(and (= :scalar (:display second-card))
(= 1
(count (:result_metadata first-card))
(count (:result_metadata second-card))))) | |
(def ^:private supported-series-display-type (set (keys (methods series-are-compatible?)))) | |
Implementaiton of Provide | (defn- fetch-compatible-series*
[card {:keys [query last-cursor page-size exclude-ids] :as _options}]
(let [matching-cards (t2/select Card
:archived false
:display [:in supported-series-display-type]
:id [:not= (:id card)]
(cond-> {:order-by [[:id :desc]]
:where [:and]}
last-cursor
(update :where conj [:< :id last-cursor])
(seq exclude-ids)
(update :where conj [:not [:in :id exclude-ids]])
query
(update :where conj [:like :%lower.name (str "%" (u/lower-case-en query) "%")])
;; add a little buffer to the page to account for cards that are not
;; compatible + do not have permissions to read
;; this is just a heuristic, but it should be good enough
page-size
(assoc :limit (+ 10 page-size))))
compatible-cards (->> matching-cards
(filter mi/can-read?)
(filter #(or
;; columns name on native query are not match with the column name in viz-settings. why??
;; so we can't use series-are-compatible? to filter out incompatible native cards.
;; => we assume all native queries are compatible and FE will figure it out later
(= (:query_type %) :native)
(series-are-compatible? card %))))]
(if page-size
(take page-size compatible-cards)
compatible-cards))) |
Fetch a list of compatible series for options:
- exclude-ids: filter out these card ids
- query: filter cards by name
- last-cursor: the id of the last card from the previous page
- page-size: is nullable, it'll try to fetches exactly | (defn- fetch-compatible-series
([card options]
(fetch-compatible-series card options []))
([card {:keys [page-size] :as options} current-cards]
(let [cards (fetch-compatible-series* card options)
new-cards (concat current-cards cards)]
;; if the total card fetches is less than page-size and there are still more, continue fetching
(if (and (some? page-size)
(seq cards)
(< (count cards) page-size))
(fetch-compatible-series card
(merge options
{:page-size (- page-size (count cards))
:last-cursor (:id (last cards))})
new-cards)
new-cards)))) |
/:id/series | (api/defendpoint GET
"Fetches a list of comptatible series with the card with id `card_id`.
- `last_cursor` with value is the id of the last card from the previous page to fetch the next page.
- `query` to search card by name.
- `exclude_ids` to filter out a list of card ids"
[id last_cursor query exclude_ids]
{id int?
last_cursor [:maybe ms/PositiveInt]
query [:maybe ms/NonBlankString]
exclude_ids [:maybe [:fn
{:error/fn (fn [_ _] (deferred-tru "value must be a sequence of positive integers"))}
(fn [ids]
(every? pos-int? (api/parse-multi-values-param ids parse-long)))]]}
(let [exclude_ids (when exclude_ids (api/parse-multi-values-param exclude_ids parse-long))
card (-> (t2/select-one :model/Card :id id) api/check-404 api/read-check)
card-display (:display card)]
(when-not (supported-series-display-type card-display)
(throw (ex-info (tru "Card with type {0} is not compatible to have series" (name card-display))
{:display card-display
:allowed-display (map name supported-series-display-type)
:status-code 400})))
(fetch-compatible-series
card
{:exclude-ids exclude_ids
:query query
:last-cursor last_cursor
:page-size mw.offset-paging/*limit*}))) |
/:id/timelines | (api/defendpoint GET
"Get the timelines for card with ID. Looks up the collection the card is in and uses that."
[id include start end]
{id ms/PositiveInt
include [:maybe [:= "events"]]
start [:maybe ms/TemporalString]
end [:maybe ms/TemporalString]}
(let [{:keys [collection_id] :as _card} (api/read-check Card id)]
;; subtlety here. timeline access is based on the collection at the moment so this check should be identical. If
;; we allow adding more timelines to a card in the future, we will need to filter on read-check and i don't think
;; the read-checks are particularly fast on multiple items
(timeline/timelines-for-collection collection_id
{:timeline/events? (= include "events")
:events/start (when start (u.date/parse start))
:events/end (when end (u.date/parse end))}))) |
-------------------------------------------------- Saving Cards -------------------------------------------------- | |
Make sure the Current User has the appropriate data permissions to run | (defn check-data-permissions-for-query
[query]
{:pre [(map? query)]}
(when-not (query-perms/can-run-query? query)
(let [required-perms (try
(query-perms/perms-set query :throw-exceptions? true)
(catch Throwable e
e))]
(throw (ex-info (tru "You cannot save this Question because you do not have permissions to run its query.")
{:status-code 403
:query query
:required-perms (if (instance? Throwable required-perms)
:error
required-perms)
:actual-perms @api/*current-user-permissions-set*}
(when (instance? Throwable required-perms)
required-perms)))))) |
------------------------------------------------- Creating Cards ------------------------------------------------- | |
/ | (api/defendpoint POST
"Create a new `Card`."
[:as {{:keys [collection_id collection_position dataset dataset_query description display name
parameters parameter_mappings result_metadata visualization_settings cache_ttl], :as body} :body}]
{name ms/NonBlankString
dataset [:maybe :boolean]
dataset_query ms/Map
parameters [:maybe [:sequential ms/Parameter]]
parameter_mappings [:maybe [:sequential ms/ParameterMapping]]
description [:maybe ms/NonBlankString]
display ms/NonBlankString
visualization_settings ms/Map
collection_id [:maybe ms/PositiveInt]
collection_position [:maybe ms/PositiveInt]
result_metadata [:maybe qr/ResultsMetadata]
cache_ttl [:maybe ms/PositiveInt]}
;; check that we have permissions to run the query that we're trying to save
(check-data-permissions-for-query dataset_query)
;; check that we have permissions for the collection we're trying to save this card to, if applicable
(collection/check-write-perms-for-collection collection_id)
(-> (card/create-card! body @api/*current-user*)
hydrate-card-details
(assoc :last-edit-info (last-edit/edit-information-for-user @api/*current-user*)))) |
/:id/copy | (api/defendpoint POST
"Copy a `Card`, with the new name 'Copy of _name_'"
[id]
{id [:maybe ms/PositiveInt]}
(let [orig-card (api/read-check Card id)
new-name (str (trs "Copy of ") (:name orig-card))
new-card (assoc orig-card :name new-name)]
(-> (card/create-card! new-card @api/*current-user*)
hydrate-card-details
(assoc :last-edit-info (last-edit/edit-information-for-user @api/*current-user*))))) |
------------------------------------------------- Updating Cards ------------------------------------------------- | |
If the query is being modified, check that we have data permissions to run the query. | (defn- check-allowed-to-modify-query
[card-before-updates card-updates]
(let [card-updates (m/update-existing card-updates :dataset_query mbql.normalize/normalize)]
(when (api/column-will-change? :dataset_query card-before-updates card-updates)
(check-data-permissions-for-query (:dataset_query card-updates))))) |
You must be a superuser to change the value of | (defn- check-allowed-to-change-embedding
[card-before-updates card-updates]
(when (or (api/column-will-change? :enable_embedding card-before-updates card-updates)
(api/column-will-change? :embedding_params card-before-updates card-updates))
(validation/check-embedding-enabled)
(api/check-superuser))) |
/:id | (api/defendpoint PUT
"Update a `Card`."
[id :as {{:keys [dataset_query description display name visualization_settings archived collection_id
collection_position enable_embedding embedding_params result_metadata parameters
cache_ttl dataset collection_preview]
:as card-updates} :body}]
{id ms/PositiveInt
name [:maybe ms/NonBlankString]
parameters [:maybe [:sequential ms/Parameter]]
dataset_query [:maybe ms/Map]
dataset [:maybe :boolean]
display [:maybe ms/NonBlankString]
description [:maybe :string]
visualization_settings [:maybe ms/Map]
archived [:maybe :boolean]
enable_embedding [:maybe :boolean]
embedding_params [:maybe ms/EmbeddingParams]
collection_id [:maybe ms/PositiveInt]
collection_position [:maybe ms/PositiveInt]
result_metadata [:maybe qr/ResultsMetadata]
cache_ttl [:maybe ms/PositiveInt]
collection_preview [:maybe :boolean]}
(let [card-before-update (t2/hydrate (api/write-check Card id)
[:moderation_reviews :moderator_details])]
;; Do various permissions checks
(doseq [f [collection/check-allowed-to-change-collection
check-allowed-to-modify-query
check-allowed-to-change-embedding]]
(f card-before-update card-updates))
;; make sure we have the correct `result_metadata`
(let [result-metadata-chan (card/result-metadata-async {:original-query (:dataset_query card-before-update)
:query dataset_query
:metadata result_metadata
:original-metadata (:result_metadata card-before-update)
:dataset? (if (some? dataset)
dataset
(:dataset card-before-update))})
card-updates (merge card-updates
(when dataset
{:display :table}))
metadata-timeout (a/timeout card/metadata-sync-wait-ms)
[fresh-metadata port] (a/alts!! [result-metadata-chan metadata-timeout])
timed-out? (= port metadata-timeout)
card-updates (cond-> card-updates
(not timed-out?)
(assoc :result_metadata fresh-metadata))]
(u/prog1 (-> (card/update-card! {:card-before-update card-before-update
:card-updates card-updates
:actor @api/*current-user*})
hydrate-card-details
(assoc :last-edit-info (last-edit/edit-information-for-user @api/*current-user*)))
(when timed-out?
(log/info (trs "Metadata not available soon enough. Saving card {0} and asynchronously updating metadata" id))
(card/schedule-metadata-saving result-metadata-chan <>)))))) |
------------------------------------------------- Deleting Cards ------------------------------------------------- | |
/:id TODO - Pretty sure this endpoint is not actually used any more, since Cards are supposed to get archived (via PUT /api/card/:id) instead of deleted. Should we remove this? | (api/defendpoint DELETE
"Delete a Card. (DEPRECATED -- don't delete a Card anymore -- archive it instead.)"
[id]
{id ms/PositiveInt}
(log/warn (tru "DELETE /api/card/:id is deprecated. Instead, change its `archived` value via PUT /api/card/:id."))
(let [card (api/write-check Card id)]
(t2/delete! Card :id id)
(events/publish-event! :event/card-delete {:object card :user-id api/*current-user-id*}))
api/generic-204-no-content) |
-------------------------------------------- Bulk Collections Update --------------------------------------------- | |
For cards that have a position in the previous collection, add them to the end of the new collection, trying to preseve the order from the original collections. Note it's possible for there to be multiple collections (and thus duplicate collection positions) merged into this new collection. No special tie breaker logic for when that's the case, just use the order the DB returned it in | (defn- update-collection-positions!
[new-collection-id-or-nil cards]
;; Sorting by `:collection_position` to ensure lower position cards are appended first
(let [sorted-cards (sort-by :collection_position cards)
max-position-result (t2/select-one [Card [:%max.collection_position :max_position]]
:collection_id new-collection-id-or-nil)
;; collection_position for the next card in the collection
starting-position (inc (get max-position-result :max_position 0))]
;; This is using `map` but more like a `doseq` with multiple seqs. Wrapping this in a `doall` as we don't want it
;; to be lazy and we're just going to discard the results
(doall
(map (fn [idx {:keys [collection_id collection_position] :as card}]
;; We are removing this card from `collection_id` so we need to reconcile any
;; `collection_position` entries left behind by this move
(api/reconcile-position-for-collection! collection_id collection_position nil)
;; Now we can update the card with the new collection and a new calculated position
;; that appended to the end
(t2/update! Card
(u/the-id card)
{:collection_position idx
:collection_id new-collection-id-or-nil}))
;; These are reversed because of the classic issue when removing an item from array. If we remove an
;; item at index 1, everthing above index 1 will get decremented. By reversing our processing order we
;; can avoid changing the index of cards we haven't yet updated
(reverse (range starting-position (+ (count sorted-cards) starting-position)))
(reverse sorted-cards))))) |
(defn- move-cards-to-collection! [new-collection-id-or-nil card-ids]
;; if moving to a collection, make sure we have write perms for it
(when new-collection-id-or-nil
(api/write-check Collection new-collection-id-or-nil))
;; for each affected card...
(when (seq card-ids)
(let [cards (t2/select [Card :id :collection_id :collection_position :dataset_query]
{:where [:and [:in :id (set card-ids)]
[:or [:not= :collection_id new-collection-id-or-nil]
(when new-collection-id-or-nil
[:= :collection_id nil])]]})] ; poisioned NULLs = ick
;; ...check that we have write permissions for it...
(doseq [card cards]
(api/write-check card))
;; ...and check that we have write permissions for the old collections if applicable
(doseq [old-collection-id (set (filter identity (map :collection_id cards)))]
(api/write-check Collection old-collection-id))
;; Ensure all of the card updates occur in a transaction. Read commited (the default) really isn't what we want
;; here. We are querying for the max card position for a given collection, then using that to base our position
;; changes if the cards are moving to a different collection. Without repeatable read here, it's possible we'll
;; get duplicates
(t2/with-transaction [_conn]
;; If any of the cards have a `:collection_position`, we'll need to fixup the old collection now that the cards
;; are gone and update the position in the new collection
(when-let [cards-with-position (seq (filter :collection_position cards))]
(update-collection-positions! new-collection-id-or-nil cards-with-position))
;; ok, everything checks out. Set the new `collection_id` for all the Cards that haven't been updated already
(when-let [cards-without-position (seq (for [card cards
:when (not (:collection_position card))]
(u/the-id card)))]
(t2/update! (t2/table-name Card)
{:id [:in (set cards-without-position)]}
{:collection_id new-collection-id-or-nil})))))) | |
/collections | (api/defendpoint POST
"Bulk update endpoint for Card Collections. Move a set of `Cards` with `card_ids` into a `Collection` with
`collection_id`, or remove them from any Collections by passing a `null` `collection_id`."
[:as {{:keys [card_ids collection_id]} :body}]
{card_ids [:sequential ms/PositiveInt]
collection_id [:maybe ms/PositiveInt]}
(move-cards-to-collection! collection_id card_ids)
{:status :ok}) |
------------------------------------------------ Running a Query ------------------------------------------------- | |
/:card-id/query | (api/defendpoint POST
"Run the query associated with a Card."
[card-id :as {{:keys [parameters ignore_cache dashboard_id collection_preview], :or {ignore_cache false dashboard_id nil}} :body}]
{card-id ms/PositiveInt
ignore_cache [:maybe :boolean]
collection_preview [:maybe :boolean]
dashboard_id [:maybe ms/PositiveInt]}
;; TODO -- we should probably warn if you pass `dashboard_id`, and tell you to use the new
;;
;; POST /api/dashboard/:dashboard-id/card/:card-id/query
;;
;; endpoint instead. Or error in that situtation? We're not even validating that you have access to this Dashboard.
(qp.card/run-query-for-card-async
card-id :api
:parameters parameters
:ignore_cache ignore_cache
:dashboard-id dashboard_id
:context (if collection_preview :collection :question)
:middleware {:process-viz-settings? false})) |
/:card-id/query/:export-format | (api/defendpoint POST
"Run the query associated with a Card, and return its results as a file in the specified format.
`parameters` should be passed as query parameter encoded as a serialized JSON string (this is because this endpoint
is normally used to power 'Download Results' buttons that use HTML `form` actions)."
[card-id export-format :as {{:keys [parameters]} :params}]
{card-id ms/PositiveInt
parameters [:maybe ms/JSONString]
export-format (into [:enum] api.dataset/export-formats)}
(qp.card/run-query-for-card-async
card-id export-format
:parameters (json/parse-string parameters keyword)
:constraints nil
:context (api.dataset/export-format->context export-format)
:middleware {:process-viz-settings? true
:skip-results-metadata? true
:ignore-cached-results? true
:format-rows? false
:js-int-to-string? false})) |
----------------------------------------------- Sharing is Caring ------------------------------------------------ | |
/:card-id/public_link | (api/defendpoint POST
"Generate publicly-accessible links for this Card. Returns UUID to be used in public links. (If this Card has
already been shared, it will return the existing public link rather than creating a new one.) Public sharing must
be enabled."
[card-id]
{card-id ms/PositiveInt}
(validation/check-has-application-permission :setting)
(validation/check-public-sharing-enabled)
(api/check-not-archived (api/read-check Card card-id))
(let [{existing-public-uuid :public_uuid} (t2/select-one [Card :public_uuid] :id card-id)]
{:uuid (or existing-public-uuid
(u/prog1 (str (random-uuid))
(t2/update! Card card-id
{:public_uuid <>
:made_public_by_id api/*current-user-id*})))})) |
/:card-id/public_link | (api/defendpoint DELETE
"Delete the publicly-accessible link to this Card."
[card-id]
{card-id ms/PositiveInt}
(validation/check-has-application-permission :setting)
(validation/check-public-sharing-enabled)
(api/check-exists? Card :id card-id, :public_uuid [:not= nil])
(t2/update! Card card-id
{:public_uuid nil
:made_public_by_id nil})
{:status 204, :body nil}) |
/public | (api/defendpoint GET "Fetch a list of Cards with public UUIDs. These cards are publicly-accessible *if* public sharing is enabled." [] (validation/check-has-application-permission :setting) (validation/check-public-sharing-enabled) (t2/select [Card :name :id :public_uuid], :public_uuid [:not= nil], :archived false)) |
/embeddable | (api/defendpoint GET "Fetch a list of Cards where `enable_embedding` is `true`. The cards can be embedded using the embedding endpoints and a signed JWT." [] (validation/check-has-application-permission :setting) (validation/check-embedding-enabled) (t2/select [Card :name :id], :enable_embedding true, :archived false)) |
/:id/related | (api/defendpoint GET
"Return related entities."
[id]
{id ms/PositiveInt}
(-> (t2/select-one Card :id id) api/read-check related/related)) |
/related | (api/defendpoint POST
"Return related entities for an ad-hoc query."
[:as {query :body}]
(related/related (query/adhoc-query query))) |
/pivot/:card-id/query | (api/defendpoint POST
"Run the query associated with a Card."
[card-id :as {{:keys [parameters ignore_cache]
:or {ignore_cache false}} :body}]
{card-id ms/PositiveInt
ignore_cache [:maybe :boolean]}
(qp.card/run-query-for-card-async card-id :api
:parameters parameters,
:qp-runner qp.pivot/run-pivot-query
:ignore_cache ignore_cache)) |
/:card-id/persist | (api/defendpoint POST
"Mark the model (card) as persisted. Runs the query and saves it to the database backing the card and hot swaps this
query in place of the model's query."
[card-id]
{card-id ms/PositiveInt}
(premium-features/assert-has-feature :cache-granular-controls (tru "Granular cache controls"))
(api/let-404 [{:keys [dataset database_id] :as card} (t2/select-one Card :id card-id)]
(let [database (t2/select-one Database :id database_id)]
(api/write-check database)
(when-not (driver/database-supports? (:engine database)
:persist-models database)
(throw (ex-info (tru "Database does not support persisting")
{:status-code 400
:database (:name database)})))
(when-not (driver/database-supports? (:engine database)
:persist-models-enabled database)
(throw (ex-info (tru "Persisting models not enabled for database")
{:status-code 400
:database (:name database)})))
(when-not dataset
(throw (ex-info (tru "Card is not a model") {:status-code 400})))
(when-let [persisted-info (persisted-info/turn-on-model! api/*current-user-id* card)]
(task.persist-refresh/schedule-refresh-for-individual! persisted-info))
api/generic-204-no-content))) |
/:card-id/refresh | (api/defendpoint POST
"Refresh the persisted model caching `card-id`."
[card-id]
{card-id ms/PositiveInt}
(api/let-404 [card (t2/select-one Card :id card-id)
persisted-info (t2/select-one PersistedInfo :card_id card-id)]
(when (not (:dataset card))
(throw (ex-info (trs "Cannot refresh a non-model question") {:status-code 400})))
(when (:archived card)
(throw (ex-info (trs "Cannot refresh an archived model") {:status-code 400})))
(api/write-check (t2/select-one Database :id (:database_id persisted-info)))
(task.persist-refresh/schedule-refresh-for-individual! persisted-info)
api/generic-204-no-content)) |
/:card-id/unpersist | (api/defendpoint POST
"Unpersist this model. Deletes the persisted table backing the model and all queries after this will use the card's
query rather than the saved version of the query."
[card-id]
{card-id ms/PositiveInt}
(premium-features/assert-has-feature :cache-granular-controls (tru "Granular cache controls"))
(api/let-404 [_card (t2/select-one Card :id card-id)]
(api/let-404 [persisted-info (t2/select-one PersistedInfo :card_id card-id)]
(api/write-check (t2/select-one Database :id (:database_id persisted-info)))
(persisted-info/mark-for-pruning! {:id (:id persisted-info)} "off")
api/generic-204-no-content))) |
Get param values for the "old style" parameters. This mimic's the api/dashboard version except we don't have chain-filter issues or dashcards to worry about. | (defn mapping->field-values
[card param query]
(when-let [field-clause (params/param-target->field-clause (:target param) card)]
(when-let [field-id (mbql.u/match-one field-clause [:field (id :guard integer?) _] id)]
(api.field/search-values-from-field-id field-id query)))) |
Fetch values for a parameter that contain The source of values could be: - static-list: user defined values list - card: values is result of running a card | (mu/defn param-values
([card param-key]
(param-values card param-key nil))
([card :- ms/Map
param-key :- ms/NonBlankString
query :- [:maybe ms/NonBlankString]]
(let [param (get (m/index-by :id (or (seq (:parameters card))
;; some older cards or cards in e2e just use the template tags on native queries
(card/template-tag-parameters card)))
param-key)]
(when-not param
(throw (ex-info (tru "Card does not have a parameter with the ID {0}" (pr-str param-key))
{:status-code 400})))
(custom-values/parameter->values param query (fn [] (mapping->field-values card param query)))))) |
/:card-id/params/:param-key/values | (api/defendpoint GET
"Fetch possible values of the parameter whose ID is `:param-key`.
;; fetch values for Card 1 parameter 'abc' that are possible
GET /api/card/1/params/abc/values"
[card-id param-key]
{card-id ms/PositiveInt
param-key ms/NonBlankString}
(param-values (api/read-check Card card-id) param-key)) |
/:card-id/params/:param-key/search/:query | (api/defendpoint GET
"Fetch possible values of the parameter whose ID is `:param-key` that contain `:query`.
;; fetch values for Card 1 parameter 'abc' that contain 'Orange';
GET /api/card/1/params/abc/search/Orange
Currently limited to first 1000 results."
[card-id param-key query]
{card-id ms/PositiveInt
param-key ms/NonBlankString
query ms/NonBlankString}
(param-values (api/read-check Card card-id) param-key query)) |
This helper function exists to make testing the POST /api/card/from-csv endpoint easier. | (defn- from-csv!
[{:keys [collection-id filename file]}]
(try
(let [model (upload/create-csv-upload! {:collection-id collection-id
:filename filename
:file file
:schema-name (public-settings/uploads-schema-name)
:table-prefix (public-settings/uploads-table-prefix)
:db-id (or (public-settings/uploads-database-id)
(throw (ex-info (tru "The uploads database is not configured.")
{:status-code 422})))})]
{:status 200
:body (:id model)})
(catch Throwable e
{:status (or (-> e ex-data :status-code)
500)
:body {:message (or (ex-message e)
(tru "There was an error uploading the file"))}})
(finally (io/delete-file file :silently)))) |
/from-csv | (api/defendpoint ^:multipart POST
"Create a table and model populated with the values from the attached CSV. Returns the model ID if successful."
[:as {raw-params :params}]
;; parse-long returns nil with "root" as the collection ID, which is what we want anyway
(from-csv! {:collection-id (parse-long (get raw-params "collection_id"))
:filename (get-in raw-params ["file" :filename])
:file (get-in raw-params ["file" :tempfile])})) |
(api/define-routes) | |
| (ns metabase.api.collection
(:require
[cheshire.core :as json]
[clojure.string :as str]
[compojure.core :refer [GET POST PUT]]
[honey.sql.helpers :as sql.helpers]
[malli.core :as mc]
[malli.transform :as mtx]
[medley.core :as m]
[metabase.api.common :as api]
[metabase.db :as mdb]
[metabase.db.query :as mdb.query]
[metabase.driver.common.parameters :as params]
[metabase.driver.common.parameters.parse :as params.parse]
[metabase.mbql.normalize :as mbql.normalize]
[metabase.models.card :as card :refer [Card]]
[metabase.models.collection :as collection :refer [Collection]]
[metabase.models.collection.graph :as graph]
[metabase.models.collection.root :as collection.root]
[metabase.models.dashboard :refer [Dashboard]]
[metabase.models.interface :as mi]
[metabase.models.native-query-snippet :refer [NativeQuerySnippet]]
[metabase.models.permissions :as perms]
[metabase.models.pulse :as pulse :refer [Pulse]]
[metabase.models.revision.last-edit :as last-edit]
[metabase.models.timeline :as timeline :refer [Timeline]]
[metabase.public-settings.premium-features
:as premium-features
:refer [defenterprise]]
[metabase.server.middleware.offset-paging :as mw.offset-paging]
[metabase.util :as u]
[metabase.util.honey-sql-2 :as h2x]
[metabase.util.i18n :refer [tru]]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
when alias defined for namespaced keywords is run through kondo macro, ns should be regarded as used | (comment collection.root/keep-me) |
(declare root-collection) | |
Clause to restrict which collections are being selected based off collection-id. If collection-id is nil, then restrict to the children and the grandchildren of the root collection. If collection-id is an an integer, then restrict to that collection's parents and children. | (defn- location-from-collection-id-clause
[collection-id]
(if collection-id
[:and
[:like :location (str "%/" collection-id "/%")]
[:not [:like :location (str "%/" collection-id "/%/%/%")]]]
[:not [:like :location "/%/%/"]])) |
(defn- remove-other-users-personal-subcollections
[user-id collections]
(let [personal-ids (set (t2/select-fn-set :id :model/Collection
{:where
[:and [:!= :personal_owner_id nil] [:!= :personal_owner_id user-id]]}))
personal-descendant? (fn [collection]
(let [first-parent-collection-id (-> collection
:location
collection/location-path->ids
first)]
(personal-ids first-parent-collection-id)))]
(remove personal-descendant? collections))) | |
Select collections based off certain parameters. If For archived, we can either pass in include both (when archived is nil), include only archived is true, or archived is false. | (defn- select-collections
[archived exclude-other-user-collections namespace shallow collection-id]
(cond->>
(t2/select :model/Collection
{:where [:and
(when (some? archived)
[:= :archived archived])
(when shallow
(location-from-collection-id-clause collection-id))
(when exclude-other-user-collections
[:or [:= :personal_owner_id nil] [:= :personal_owner_id api/*current-user-id*]])
(perms/audit-namespace-clause :namespace namespace)
(collection/visible-collection-ids->honeysql-filter-clause
:id
(collection/permissions-set->visible-collection-ids @api/*current-user-permissions-set*))]
;; Order NULL collection types first so that audit collections are last
:order-by [[[[:case [:= :type nil] 0 :else 1]] :asc]
[:%lower.name :asc]]})
exclude-other-user-collections (remove-other-users-personal-subcollections api/*current-user-id*))) |
/ | (api/defendpoint GET
"Fetch a list of all Collections that the current user has read permissions for (`:can_write` is returned as an
additional property of each Collection so you can tell which of these you have write permissions for.)
By default, this returns non-archived Collections, but instead you can show archived ones by passing
`?archived=true`.
By default, admin users will see all collections. To hide other user's collections pass in
`?exclude-other-user-collections=true`."
[archived exclude-other-user-collections namespace]
{archived [:maybe ms/BooleanValue]
exclude-other-user-collections [:maybe ms/BooleanValue]
namespace [:maybe ms/NonBlankString]}
(as->
(select-collections archived exclude-other-user-collections namespace false nil) collections
;; include Root Collection at beginning or results if archived isn't `true`
(if archived
collections
(let [root (root-collection namespace)]
(cond->> collections
(mi/can-read? root)
(cons root))))
(t2/hydrate collections :can_write :is_personal)
;; remove the :metabase.models.collection.root/is-root? tag since FE doesn't need it
;; and for personal collections we translate the name to user's locale
(for [collection collections]
(-> collection
(dissoc ::collection.root/is-root?)
collection/personal-collection-with-ui-details)))) |
Returns only a shallow Collection in the provided collection-id, e.g. location: /1/ ``` [{:name "A" :location "/1/" :children 1} ... {:name "H" :location "/1/"}] If the collection-id is nil, then we default to the root collection. ``` | (defn- shallow-tree-from-collection-id
[colls]
(->> colls
(map collection/personal-collection-with-ui-details)
(collection/collections->tree nil)
(map (fn [coll] (update coll :children #(boolean (seq %))))))) |
/tree | (api/defendpoint GET
"Similar to `GET /`, but returns Collections in a tree structure, e.g.
```
[{:name \"A\"
:below #{:card :dataset}
:children [{:name \"B\"}
{:name \"C\"
:here #{:dataset :card}
:below #{:dataset :card}
:children [{:name \"D\"
:here #{:dataset}
:children [{:name \"E\"}]}
{:name \"F\"
:here #{:card}
:children [{:name \"G\"}]}]}]}
{:name \"H\"}]
```
The here and below keys indicate the types of items at this particular level of the tree (here) and in its
subtree (below)."
[exclude-archived exclude-other-user-collections namespace shallow collection-id]
{exclude-archived [:maybe :boolean]
exclude-other-user-collections [:maybe :boolean]
namespace [:maybe ms/NonBlankString]
shallow [:maybe :boolean]
collection-id [:maybe ms/PositiveInt]}
(let [archived (if exclude-archived false nil)
collections (select-collections archived exclude-other-user-collections namespace shallow collection-id)]
(if shallow
(shallow-tree-from-collection-id collections)
(let [collection-type-ids (reduce (fn [acc {:keys [collection_id dataset] :as _x}]
(update acc (if dataset :dataset :card) conj collection_id))
{:dataset #{}
:card #{}}
(mdb.query/reducible-query {:select-distinct [:collection_id :dataset]
:from [:report_card]
:where [:= :archived false]}))
collections-with-details (map collection/personal-collection-with-ui-details collections)]
(collection/collections->tree collection-type-ids collections-with-details))))) |
--------------------------------- Fetching a single Collection & its 'children' ---------------------------------- | |
Valid values for the | (def ^:private valid-model-param-values
#{"card" "dataset" "collection" "dashboard" "pulse" "snippet" "no_models" "timeline"}) |
(def ^:private ModelString (into [:enum] valid-model-param-values)) | |
This is basically a union type. [[api/defendpoint]] splits the string if it only gets one. | (def ^:private Models [:or [:sequential ModelString] ModelString]) |
Valid values for the | (def ^:private valid-pinned-state-values
#{"all" "is_pinned" "is_not_pinned"}) |
(def ^:private valid-sort-columns #{"name" "last_edited_at" "last_edited_by" "model"})
(def ^:private valid-sort-directions #{"asc" "desc"})
(defn- normalize-sort-choice [w] (when w (keyword (str/replace w #"_" "-")))) | |
(def ^:private CollectionChildrenOptions
[:map
[:archived? :boolean]
[:pinned-state {:optional true} [:maybe (into [:enum] (map keyword) valid-pinned-state-values)]]
;; when specified, only return results of this type.
[:models {:optional true} [:maybe [:set (into [:enum] (map keyword) valid-model-param-values)]]]
[:sort-info {:optional true} [:maybe [:tuple
(into [:enum {:error/message "sort-columns"}]
(map normalize-sort-choice)
valid-sort-columns)
(into [:enum {:error/message "sort-direction"}]
(map normalize-sort-choice)
valid-sort-directions)]]]]) | |
Query that will fetch the 'children' of a NOTES:
| (defmulti ^:private collection-children-query
{:arglists '([model collection options])}
(fn [model _ _] (keyword model))) |
TODO -- in Postgres and H2 at least I think we could just do | |
A Honey SQL expression that is always true. 1 = 1 | (def ^:private always-true-hsql-expr [:= [:inline 1] [:inline 1]]) |
A Honey SQL expression that is never true. 1 = 2 | (def ^:private always-false-hsql-expr [:= [:inline 1] [:inline 2]]) |
(defn- pinned-state->clause
([pinned-state]
(pinned-state->clause pinned-state :collection_position))
([pinned-state col]
(case pinned-state
:all always-true-hsql-expr
:is_pinned [:<> col nil]
:is_not_pinned [:= col nil]
always-true-hsql-expr))) | |
Poison a query to return no results when filtering to pinned items. Use for items that do not have a notion of pinning so that no results return when asking for pinned items. | (defn- poison-when-pinned-clause
[pinned-state]
(if (= pinned-state :is_pinned)
always-false-hsql-expr
always-true-hsql-expr)) |
(defmulti ^:private post-process-collection-children
{:arglists '([model rows])}
(fn [model _]
(keyword model))) | |
(defmethod ^:private post-process-collection-children :default [_ rows] rows) | |
(defmethod collection-children-query :pulse
[_ collection {:keys [archived? pinned-state]}]
(-> {:select-distinct [:p.id
:p.name
:p.entity_id
:p.collection_position
[(h2x/literal "pulse") :model]]
:from [[:pulse :p]]
:left-join [[:pulse_card :pc] [:= :p.id :pc.pulse_id]]
:where [:and
[:= :p.collection_id (:id collection)]
[:= :p.archived (boolean archived?)]
;; exclude alerts
[:= :p.alert_condition nil]
;; exclude dashboard subscriptions
[:= :p.dashboard_id nil]]}
(sql.helpers/where (pinned-state->clause pinned-state :p.collection_position)))) | |
(defmethod post-process-collection-children :pulse
[_ rows]
(for [row rows]
(dissoc row
:description :display :authority_level :moderated_status :icon :personal_owner_id
:collection_preview :dataset_query))) | |
Collection children query for snippets on OSS. Returns all snippets regardless of collection, because snippet collections are an EE feature. | (defenterprise snippets-collection-children-query
metabase-enterprise.snippet-collections.api.native-query-snippet
[_ {:keys [archived?]}]
{:select [:id :name :entity_id [(h2x/literal "snippet") :model]]
:from [[:native_query_snippet :nqs]]
:where [:= :archived (boolean archived?)]}) |
(defmethod collection-children-query :snippet [_ collection options] (snippets-collection-children-query collection options)) | |
(defmethod collection-children-query :timeline
[_ collection {:keys [archived? pinned-state]}]
{:select [:id :name [(h2x/literal "timeline") :model] :description :entity_id :icon]
:from [[:timeline :timeline]]
:where [:and
(poison-when-pinned-clause pinned-state)
[:= :collection_id (:id collection)]
[:= :archived (boolean archived?)]]}) | |
(defmethod post-process-collection-children :timeline
[_ rows]
(for [row rows]
(dissoc row
:description :display :collection_position :authority_level :moderated_status
:collection_preview :dataset_query))) | |
(defmethod post-process-collection-children :snippet
[_ rows]
(for [row rows]
(dissoc row
:description :collection_position :display :authority_level
:moderated_status :icon :personal_owner_id :collection_preview
:dataset_query))) | |
(defn- card-query [dataset? collection {:keys [archived? pinned-state]}]
(-> {:select (cond->
[:c.id :c.name :c.description :c.entity_id :c.collection_position :c.display :c.collection_preview
:c.dataset_query
[(h2x/literal (if dataset? "dataset" "card")) :model]
[:u.id :last_edit_user]
[:u.email :last_edit_email]
[:u.first_name :last_edit_first_name]
[:u.last_name :last_edit_last_name]
[:r.timestamp :last_edit_timestamp]
[{:select [:status]
:from [:moderation_review]
:where [:and
[:= :moderated_item_type "card"]
[:= :moderated_item_id :c.id]
[:= :most_recent true]]
;; limit 1 to ensure that there is only one result but this invariant should hold true, just
;; protecting against potential bugs
:order-by [[:id :desc]]
:limit 1}
:moderated_status]]
dataset?
(conj :c.database_id))
:from [[:report_card :c]]
:left-join [[:revision :r] [:and
[:= :r.model_id :c.id]
[:= :r.most_recent true]
[:= :r.model (h2x/literal "Card")]]
[:core_user :u] [:= :u.id :r.user_id]]
:where [:and
[:= :collection_id (:id collection)]
[:= :archived (boolean archived?)]
[:= :dataset dataset?]]}
(sql.helpers/where (pinned-state->clause pinned-state)))) | |
(defmethod collection-children-query :dataset [_ collection options] (card-query true collection options)) | |
(defmethod post-process-collection-children :dataset [_ rows] (post-process-collection-children :card rows)) | |
(defmethod collection-children-query :card [_ collection options] (card-query false collection options)) | |
Decide if The rules to consider a piece of text fully parameterized is as follows:
The first rule is absolutely necessary, as queries violating it cannot be executed without externally supplied parameter values. The second rule is more controversial, as field-filters outside of optional blocks ([[ ... ]]) don't prevent the query from being executed without external parameter values (neither do parameters in optional blocks). The rule has been added nonetheless, because marking a parameter as required is something the user does intentionally and queries that are technically executable without parameters can be unacceptably slow without the necessary constraints. (Marking parameters in optional blocks as required doesn't seem to be useful any way, but if the user said it is required, we honor this flag.) | (defn- fully-parameterized-text?
[text template-tags]
(try
(let [obligatory-params (into #{}
(comp (filter params/Param?)
(map :k))
(params.parse/parse text))]
(and (every? #(or (#{:dimension :snippet :card} (:type %))
(:default %))
(map template-tags obligatory-params))
(every? #(or (not (:required %))
(:default %))
(vals template-tags))))
(catch clojure.lang.ExceptionInfo _
;; An exception might be thrown during parameter parsing if the syntax is invalid. In this case we return
;; true so that we still can try to generate a preview for the query and display an error.
false))) |
(defn- fully-parameterized-query? [row]
(let [native-query (-> row :dataset_query json/parse-string mbql.normalize/normalize :native)]
(if-let [template-tags (:template-tags native-query)]
(fully-parameterized-text? (:query native-query) template-tags)
true))) | |
(defn- post-process-card-row [row]
(-> row
(dissoc :authority_level :icon :personal_owner_id :dataset_query)
(update :collection_preview api/bit->boolean)
(assoc :fully_parameterized (fully-parameterized-query? row)))) | |
(defmethod post-process-collection-children :card [_ rows] (map post-process-card-row rows)) | |
(defn- dashboard-query [collection {:keys [archived? pinned-state]}]
(-> {:select [:d.id :d.name :d.description :d.entity_id :d.collection_position
[(h2x/literal "dashboard") :model]
[:u.id :last_edit_user]
[:u.email :last_edit_email]
[:u.first_name :last_edit_first_name]
[:u.last_name :last_edit_last_name]
[:r.timestamp :last_edit_timestamp]]
:from [[:report_dashboard :d]]
:left-join [[:revision :r] [:and
[:= :r.model_id :d.id]
[:= :r.most_recent true]
[:= :r.model (h2x/literal "Dashboard")]]
[:core_user :u] [:= :u.id :r.user_id]]
:where [:and
[:= :collection_id (:id collection)]
[:= :archived (boolean archived?)]]}
(sql.helpers/where (pinned-state->clause pinned-state)))) | |
(defmethod collection-children-query :dashboard [_ collection options] (dashboard-query collection options)) | |
(defmethod post-process-collection-children :dashboard
[_ rows]
(map #(dissoc %
:display :authority_level :moderated_status :icon :personal_owner_id :collection_preview
:dataset_query)
rows)) | |
Clause to filter out snippet collections from the collection query on OSS instances, and instances without the
snippet-collections. EE implementation returns | (defenterprise snippets-collection-filter-clause metabase-enterprise.snippet-collections.api.native-query-snippet [] [:or [:= :namespace nil] [:not= :namespace (u/qualified-name "snippets")]]) |
(defn- collection-query
[collection {:keys [archived? collection-namespace pinned-state]}]
(-> (assoc (collection/effective-children-query
collection
[:= :archived archived?]
(perms/audit-namespace-clause :namespace (u/qualified-name collection-namespace))
(snippets-collection-filter-clause))
;; We get from the effective-children-query a normal set of columns selected:
;; want to make it fit the others to make UNION ALL work
:select [:id
:name
:description
:entity_id
:personal_owner_id
[(h2x/literal "collection") :model]
:authority_level])
;; the nil indicates that collections are never pinned.
(sql.helpers/where (pinned-state->clause pinned-state nil)))) | |
(defmethod collection-children-query :collection [_ collection options] (collection-query collection options)) | |
(defmethod post-process-collection-children :collection
[_ rows]
(letfn [(update-personal-collection [{:keys [personal_owner_id] :as row}]
(if personal_owner_id
;; when fetching root collection, we might have personal collection
(assoc row :name (collection/user->personal-collection-name (:personal_owner_id row) :user))
(dissoc row :personal_owner_id)))]
(for [row rows]
;; Go through this rigamarole instead of hydration because we
;; don't get models back from ulterior over-query
;; Previous examination with logging to DB says that there's no N+1 query for this.
;; However, this was only tested on H2 and Postgres
(-> row
(assoc :can_write (mi/can-write? Collection (:id row)))
(dissoc :collection_position :display :moderated_status :icon
:collection_preview :dataset_query)
update-personal-collection)))) | |
(mu/defn ^:private coalesce-edit-info :- last-edit/MaybeAnnotated
"Hoist all of the last edit information into a map under the key :last-edit-info. Considers this information present
if `:last_edit_user` is not nil."
[row]
(letfn [(select-as [original k->k']
(reduce (fn [m [k k']] (assoc m k' (get original k)))
{}
k->k'))]
(let [mapping {:last_edit_user :id
:last_edit_last_name :last_name
:last_edit_first_name :first_name
:last_edit_email :email
:last_edit_timestamp :timestamp}]
(cond-> (apply dissoc row :model_ranking (keys mapping))
;; don't use contains as they all have the key, we care about a value present
(:last_edit_user row) (assoc :last-edit-info (select-as row mapping)))))) | |
Post process any data. Have a chance to process all of the same type at once using
| (defn- post-process-rows
[rows]
(->> (map-indexed (fn [i row] (vary-meta row assoc ::index i)) rows) ;; keep db sort order
(group-by :model)
(into []
(comp (map (fn [[model rows]]
(post-process-collection-children (keyword model) rows)))
cat
(map coalesce-edit-info)))
(sort-by (comp ::index meta)))) |
(defn- model-name->toucan-model [model-name]
(case (keyword model-name)
:collection Collection
:card Card
:dataset Card
:dashboard Dashboard
:pulse Pulse
:snippet NativeQuerySnippet
:timeline Timeline)) | |
Takes a honeysql select column and returns a keyword of which column it is. eg: (select-name :id) -> :id (select-name [(literal "card") :model]) -> :model (select-name :p.id) -> :id | (defn- select-name
[x]
(if (vector? x)
(recur (second x))
(-> x name (str/split #"\.") peek keyword))) |
All columns that need to be present for the union-all. Generated with the comment form below. Non-text columns that are optional (not id, but lastedituser for example) must have a type so that the union-all can unify the nil with the correct column type. | (def ^:private all-select-columns [:id :name :description :entity_id :display [:collection_preview :boolean] :dataset_query :model :collection_position :authority_level [:personal_owner_id :integer] :last_edit_email :last_edit_first_name :last_edit_last_name :moderated_status :icon [:last_edit_user :integer] [:last_edit_timestamp :timestamp] [:database_id :integer]]) |
Ensures that all necessary columns are in the select-columns collection, adding | (defn- add-missing-columns
[select-columns necessary-columns]
(let [columns (m/index-by select-name select-columns)]
(map (fn [col]
(let [[col-name typpe] (u/one-or-many col)]
(get columns col-name (if (and typpe (= (mdb/db-type) :postgres))
[(h2x/cast typpe nil) col-name]
[nil col-name]))))
necessary-columns))) |
(defn- add-model-ranking
[select-clause model]
(let [rankings {:dashboard 1
:pulse 2
:dataset 3
:card 4
:snippet 5
:collection 6
:timeline 7}]
(conj select-clause [[:inline (get rankings model 100)]
:model_ranking]))) | |
(comment
;; generate the set of columns across all child queries. Remember to add type info if not a text column
(into []
(comp cat (map select-name) (distinct))
(for [model [:card :dashboard :snippet :pulse :collection :timeline]]
(:select (collection-children-query model {:id 1 :location "/"} nil))))) | |
Given the client side sort-info, return sort clause to effect this. | (defn children-sort-clause
[sort-info db-type]
(case sort-info
nil [[:%lower.name :asc]]
[:name :asc] [[:%lower.name :asc]]
[:name :desc] [[:%lower.name :desc]]
[:last-edited-at :asc] [(if (= db-type :mysql)
[:%isnull.last_edit_timestamp]
[:last_edit_timestamp :nulls-last])
[:last_edit_timestamp :asc]
[:%lower.name :asc]]
[:last-edited-at :desc] (remove nil?
[(case db-type
:mysql [:%isnull.last_edit_timestamp]
:postgres [:last_edit_timestamp :desc-nulls-last]
:h2 nil)
[:last_edit_timestamp :desc]
[:%lower.name :asc]])
[:last-edited-by :asc] [(if (= db-type :mysql)
[:%isnull.last_edit_last_name]
[:last_edit_last_name :nulls-last])
[:last_edit_last_name :asc]
(if (= db-type :mysql)
[:%isnull.last_edit_first_name]
[:last_edit_first_name :nulls-last])
[:last_edit_first_name :asc]
[:%lower.name :asc]]
[:last-edited-by :desc] (remove nil?
[(case db-type
:mysql [:%isnull.last_edit_last_name]
:postgres [:last_edit_last_name :desc-nulls-last]
:h2 nil)
[:last_edit_last_name :desc]
(case db-type
:mysql [:%isnull.last_edit_first_name]
:postgres [:last_edit_last_name :desc-nulls-last]
:h2 nil)
[:last_edit_first_name :desc]
[:%lower.name :asc]])
[:model :asc] [[:model_ranking :asc] [:%lower.name :asc]]
[:model :desc] [[:model_ranking :desc] [:%lower.name :asc]])) |
(defn- collection-children*
[collection models {:keys [sort-info] :as options}]
(let [sql-order (children-sort-clause sort-info (mdb/db-type))
models (sort (map keyword models))
queries (for [model models
:let [query (collection-children-query model collection options)
select-clause-type (some
(fn [k]
(when (get query k)
k))
[:select :select-distinct])]]
(-> query
(update select-clause-type add-missing-columns all-select-columns)
(update select-clause-type add-model-ranking model)))
total-query {:select [[:%count.* :count]]
:from [[{:union-all queries} :dummy_alias]]}
rows-query {:select [:*]
:from [[{:union-all queries} :dummy_alias]]
:order-by sql-order}
;; We didn't implement collection pagination for snippets namespace for root/items
;; Rip out the limit for now and put it back in when we want it
limit-query (if (or
(nil? mw.offset-paging/*limit*)
(nil? mw.offset-paging/*offset*)
(= (:collection-namespace options) "snippets"))
rows-query
(assoc rows-query
:limit mw.offset-paging/*limit*
:offset mw.offset-paging/*offset*))
res {:total (->> (mdb.query/query total-query) first :count)
:data (->> (mdb.query/query limit-query) post-process-rows)
:models models}
limit-res (assoc res
:limit mw.offset-paging/*limit*
:offset mw.offset-paging/*offset*)]
(if (= (:collection-namespace options) "snippets")
res
limit-res))) | |
Fetch a sequence of 'child' objects belonging to a Collection, filtered using | (mu/defn ^:private collection-children
[{collection-namespace :namespace, :as collection} :- collection/CollectionWithLocationAndIDOrRoot
{:keys [models], :as options} :- CollectionChildrenOptions]
(let [valid-models (for [model-kw [:collection :dataset :card :dashboard :pulse :snippet :timeline]
;; only fetch models that are specified by the `model` param; or everything if it's empty
:when (or (empty? models) (contains? models model-kw))
:let [toucan-model (model-name->toucan-model model-kw)
allowed-namespaces (collection/allowed-namespaces toucan-model)]
:when (or (= model-kw :collection)
(contains? allowed-namespaces (keyword collection-namespace)))]
model-kw)]
(if (seq valid-models)
(collection-children* collection valid-models (assoc options :collection-namespace collection-namespace))
{:total 0
:data []
:limit mw.offset-paging/*limit*
:offset mw.offset-paging/*offset*
:models valid-models}))) |
Add a standard set of details to | (mu/defn ^:private collection-detail
[collection :- collection/CollectionWithLocationAndIDOrRoot]
(-> collection
collection/personal-collection-with-ui-details
(t2/hydrate :parent_id :effective_location [:effective_ancestors :can_write] :can_write :is_personal))) |
/:id | (api/defendpoint GET
"Fetch a specific Collection with standard details added"
[id]
{id ms/PositiveInt}
(collection-detail (api/read-check Collection id))) |
/root/timelines | (api/defendpoint GET
"Fetch the root Collection's timelines."
[include archived]
{include [:maybe [:= "events"]]
archived [:maybe :boolean]}
(timeline/timelines-for-collection nil {:timeline/events? (= include "events")
:timeline/archived? archived})) |
/:id/timelines | (api/defendpoint GET
"Fetch a specific Collection's timelines."
[id include archived]
{id ms/PositiveInt
include [:maybe [:= "events"]]
archived [:maybe :boolean]}
(timeline/timelines-for-collection id {:timeline/events? (= include "events")
:timeline/archived? archived})) |
/:id/items | (api/defendpoint GET
"Fetch a specific Collection's items with the following options:
* `models` - only include objects of a specific set of `models`. If unspecified, returns objects of all models
* `archived` - when `true`, return archived objects *instead* of unarchived ones. Defaults to `false`.
* `pinned_state` - when `is_pinned`, return pinned objects only.
when `is_not_pinned`, return non pinned objects only.
when `all`, return everything. By default returns everything"
[id models archived pinned_state sort_column sort_direction]
{id ms/PositiveInt
models [:maybe Models]
archived [:maybe ms/BooleanString]
pinned_state [:maybe (into [:enum] valid-pinned-state-values)]
sort_column [:maybe (into [:enum] valid-sort-columns)]
sort_direction [:maybe (into [:enum] valid-sort-directions)]}
(let [model-kwds (set (map keyword (u/one-or-many models)))]
(collection-children (api/read-check Collection id)
{:models model-kwds
:archived? (Boolean/parseBoolean archived)
:pinned-state (keyword pinned_state)
:sort-info [(or (some-> sort_column normalize-sort-choice) :name)
(or (some-> sort_direction normalize-sort-choice) :asc)]}))) |
-------------------------------------------- GET /api/collection/root -------------------------------------------- | |
(defn- root-collection [collection-namespace] (collection-detail (collection/root-collection-with-ui-details collection-namespace))) | |
/root | (api/defendpoint GET
"Return the 'Root' Collection object with standard details added"
[namespace]
{namespace [:maybe ms/NonBlankString]}
(-> (root-collection namespace)
(api/read-check)
(dissoc ::collection.root/is-root?))) |
If you pass in explicitly keywords that you can't see, you can't see them. But there is an exception for the collections, because you might not be able to see the top-level collections but be able to see, children of those invisible top-level collections. | (defn- visible-model-kwds
[root-collection model-set]
(if (mi/can-read? root-collection)
model-set
(if (or (empty? model-set) (contains? model-set :collection))
#{:collection}
#{:no_models}))) |
/root/items | (api/defendpoint GET
"Fetch objects that the current user should see at their root level. As mentioned elsewhere, the 'Root' Collection
doesn't actually exist as a row in the application DB: it's simply a virtual Collection where things with no
`collection_id` exist. It does, however, have its own set of Permissions.
This endpoint will actually show objects with no `collection_id` for Users that have Root Collection
permissions, but for people without Root Collection perms, we'll just show the objects that have an effective
location of `/`.
This endpoint is intended to power a 'Root Folder View' for the Current User, so regardless you'll see all the
top-level objects you're allowed to access.
By default, this will show the 'normal' Collections namespace; to view a different Collections namespace, such as
`snippets`, you can pass the `?namespace=` parameter."
[models archived namespace pinned_state sort_column sort_direction]
{models [:maybe Models]
archived [:maybe ms/BooleanString]
namespace [:maybe ms/NonBlankString]
pinned_state [:maybe (into [:enum] valid-pinned-state-values)]
sort_column [:maybe (into [:enum] valid-sort-columns)]
sort_direction [:maybe (into [:enum] valid-sort-directions)]}
;; Return collection contents, including Collections that have an effective location of being in the Root
;; Collection for the Current User.
(let [root-collection (assoc collection/root-collection :namespace namespace)
model-set (set (map keyword (u/one-or-many models)))
model-kwds (visible-model-kwds root-collection model-set)]
(collection-children
root-collection
{:models model-kwds
:archived? (Boolean/parseBoolean archived)
:pinned-state (keyword pinned_state)
:sort-info [(or (some-> sort_column normalize-sort-choice) :name)
(or (some-> sort_direction normalize-sort-choice) :asc)]}))) |
----------------------------------------- Creating/Editing a Collection ------------------------------------------ | |
Check that you're allowed to write Collection with | (defn- write-check-collection-or-root-collection
[collection-id collection-namespace]
(api/write-check (if collection-id
(t2/select-one Collection :id collection-id)
(cond-> collection/root-collection
collection-namespace (assoc :namespace collection-namespace))))) |
Create a new collection. | (defn create-collection!
[{:keys [name description parent_id namespace authority_level]}]
;; To create a new collection, you need write perms for the location you are going to be putting it in...
(write-check-collection-or-root-collection parent_id namespace)
(when (some? authority_level)
;; make sure only admin and an EE token is present to be able to create an Official token
(premium-features/assert-has-feature :official-collections (tru "Official Collections"))
(api/check-superuser))
;; Now create the new Collection :)
(first
(t2/insert-returning-instances!
Collection
(merge
{:name name
:description description
:authority_level authority_level
:namespace namespace}
(when parent_id
{:location (collection/children-location (t2/select-one [Collection :location :id] :id parent_id))}))))) |
/ | (api/defendpoint POST
"Create a new Collection."
[:as {{:keys [name description parent_id namespace authority_level] :as body} :body}]
{name ms/NonBlankString
description [:maybe ms/NonBlankString]
parent_id [:maybe ms/PositiveInt]
namespace [:maybe ms/NonBlankString]
authority_level [:maybe collection/AuthorityLevel]}
(create-collection! body)) |
If input the TODO - I'm not 100% sure it makes sense that moving a Collection requires a special call to | (defn- move-collection-if-needed!
[collection-before-update collection-updates]
;; is a [new] parent_id update specified in the PUT request?
(when (contains? collection-updates :parent_id)
(let [orig-location (:location collection-before-update)
new-parent-id (:parent_id collection-updates)
new-parent (if new-parent-id
(t2/select-one [Collection :location :id] :id new-parent-id)
collection/root-collection)
new-location (collection/children-location new-parent)]
;; check and make sure we're actually supposed to be moving something
(when (not= orig-location new-location)
;; ok, make sure we have perms to do this operation
(api/check-403
(perms/set-has-full-permissions-for-set? @api/*current-user-permissions-set*
(collection/perms-for-moving collection-before-update new-parent)))
;; ok, we're good to move!
(collection/move-collection! collection-before-update new-location))))) |
If input the | (defn- check-allowed-to-archive-or-unarchive
[collection-before-update collection-updates]
(when (api/column-will-change? :archived collection-before-update collection-updates)
;; Check that we have approprate perms
(api/check-403
(perms/set-has-full-permissions-for-set? @api/*current-user-permissions-set*
(collection/perms-for-archiving collection-before-update))))) |
When a collection is archived, all of it's cards are also marked as archived, but this is down in the model layer which will not cause the archive notification code to fire. This will delete the relevant alerts and notify the users just as if they had be archived individually via the card API. | (defn- maybe-send-archived-notifications!
[& {:keys [collection-before-update collection-updates actor]}]
(when (api/column-will-change? :archived collection-before-update collection-updates)
(when-let [alerts (seq (pulse/retrieve-alerts-for-cards
{:card-ids (t2/select-pks-set Card :collection_id (u/the-id collection-before-update))}))]
(card/delete-alert-and-notify-archived! {:alerts alerts :actor actor})))) |
/:id | (api/defendpoint PUT
"Modify an existing Collection, including archiving or unarchiving it, or moving it."
[id, :as {{:keys [name description archived parent_id authority_level], :as collection-updates} :body}]
{id ms/PositiveInt
name [:maybe ms/NonBlankString]
description [:maybe ms/NonBlankString]
archived [:maybe ms/BooleanValue]
parent_id [:maybe ms/PositiveInt]
authority_level [:maybe collection/AuthorityLevel]}
;; do we have perms to edit this Collection?
(let [collection-before-update (api/write-check Collection id)]
;; if we're trying to *archive* the Collection, make sure we're allowed to do that
(check-allowed-to-archive-or-unarchive collection-before-update collection-updates)
;; if authority_level is changing, make sure we're allowed to do that
(when (and (contains? collection-updates :authority_level)
(not= (keyword authority_level) (:authority_level collection-before-update)))
(premium-features/assert-has-feature :official-collections (tru "Official Collections"))
(api/check-403 (and api/*is-superuser?*
;; pre-update of model checks if the collection is a personal collection and rejects changes
;; to authority_level, but it doesn't check if it is a sub-collection of a personal one so we add that
;; here
(not (collection/is-personal-collection-or-descendant-of-one? collection-before-update)))))
;; ok, go ahead and update it! Only update keys that were specified in the `body`. But not `parent_id` since
;; that's not actually a property of Collection, and since we handle moving a Collection separately below.
(let [updates (u/select-keys-when collection-updates :present [:name :description :archived :authority_level])]
(when (seq updates)
(t2/update! Collection id updates)))
;; if we're trying to *move* the Collection (instead or as well) go ahead and do that
(move-collection-if-needed! collection-before-update collection-updates)
;; if we *did* end up archiving this Collection, we most post a few notifications
(maybe-send-archived-notifications! {:collection-before-update collection-before-update
:collection-updates collection-updates
:actor @api/*current-user*}))
;; finally, return the updated object
(collection-detail (t2/select-one Collection :id id))) |
------------------------------------------------ GRAPH ENDPOINTS ------------------------------------------------- | |
/graph | (api/defendpoint GET
"Fetch a graph of all Collection Permissions."
[namespace]
{namespace [:maybe ms/NonBlankString]}
(api/check-superuser)
(graph/graph namespace)) |
an id for a [[Collection]]. | (def CollectionID
[pos-int? {:title "Collection ID"}]) |
an id for a [[PermissionsGroup]]. | (def GroupID
[pos-int? {:title "Group ID"}]) |
Malli enum for what sort of collection permissions we have. (:write :read or :none) | (def CollectionPermissions [:and keyword? [:enum :write :read :none]]) |
Map describing permissions for a (Group x Collection) | (def GroupPermissionsGraph
[:map-of
[:or
;; We need the [:and keyword ...] piece to make decoding "root" work. There's a merged fix for this, but it hasn't
;; been released as of malli 0.9.2. When the malli version gets bumped, we should remove this.
[:and keyword? [:= :root]]
CollectionID]
CollectionPermissions]) |
Map describing permissions for 1 or more groups. Revision # is used for consistency | (def PermissionsGraph [:map [:revision int?] [:groups [:map-of GroupID GroupPermissionsGraph]]]) |
Building it this way is a lot faster then calling mc/decode | (def ^:private graph-decoder (mc/decoder PermissionsGraph (mtx/string-transformer))) |
(defn- decode-graph [permission-graph] ;; TODO: should use a coercer for this? (graph-decoder permission-graph)) | |
/graph | (api/defendpoint PUT
"Do a batch update of Collections Permissions by passing in a modified graph.
Will overwrite parts of the graph that are present in the request, and leave the rest unchanged."
[:as {{:keys [namespace], :as body} :body}]
{body :map
namespace [:maybe ms/NonBlankString]}
(api/check-superuser)
(->> (dissoc body :namespace)
decode-graph
(graph/update-graph! namespace))
(graph/graph namespace)) |
(api/define-routes) | |
API Endpoints at MetabaseWe use a custom macro called
As you can see, the arguments are:
| |
Dynamic variables and utility functions/macros for writing API functions. | (ns metabase.api.common
(:require
[clojure.set :as set]
[clojure.spec.alpha :as s]
[clojure.string :as str]
[compojure.core :as compojure]
[medley.core :as m]
[metabase.api.common.internal
:refer [add-route-param-schema
auto-coerce
route-dox
validate-params
route-fn-name
wrap-response-if-needed]]
[metabase.config :as config]
[metabase.events :as events]
[metabase.models.interface :as mi]
[metabase.util :as u]
[metabase.util.i18n :as i18n :refer [deferred-tru tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[ring.middleware.multipart-params :as mp]
[toucan2.core :as t2])) |
(declare check-403 check-404) | |
----------------------------------------------- DYNAMIC VARIABLES ------------------------------------------------ These get bound by middleware for each HTTP request. | |
Int ID or | (def ^:dynamic ^Integer *current-user-id* nil) |
Delay that returns the | (def ^:dynamic *current-user* (atom nil)) ; default binding is just something that will return nil when dereferenced |
Is the current user a superuser? | (def ^:dynamic ^Boolean *is-superuser?* false) |
Is the current user a group manager of at least one group? | (def ^:dynamic ^Boolean *is-group-manager?* false) |
Delay to the set of permissions granted to the current user. See documentation in [[metabase.models.permissions]] for more information about the Metabase permissions system. | (def ^:dynamic *current-user-permissions-set*
(atom #{})) |
---------------------------------------- Precondition checking helper fns ---------------------------------------- | |
(defn- check-one [condition code message]
(when-not condition
(let [[message info] (if (and (map? message)
(not (i18n/localized-string? message)))
[(:message message) message]
[message])]
(throw (ex-info (str message) (assoc info :status-code code)))))
condition) | |
Assertion mechanism for use inside API functions.
Checks that
This exception is automatically caught in the body of
or with the form
You can also include multiple tests in a single call: (check test1 code1 message1 test2 code2 message2) | (defn check
{:style/indent 1, :arglists '([condition [code message] & more] [condition code message & more])}
[condition & args]
(let [[code message & more] (if (sequential? (first args))
(concat (first args) (rest args))
args)]
(check-one condition code message)
(if (seq more)
(recur (first more) (rest more))
condition))) |
Check that object with ID (or other key/values) exists in the DB, or throw a 404. | (defn check-exists? ([entity id] (check-exists? entity :id id)) ([entity k v & more] (check-404 (apply t2/exists? entity k v more)))) |
Check that | (defn check-superuser [] (check-403 *is-superuser?*)) |
checkp- functions: as in "check param". These functions expect that you pass a symbol so they can throw exceptions w/ relevant error messages. | |
Throw an | (defn throw-invalid-param-exception
[field-name message]
(throw (ex-info (tru "Invalid field: {0}" field-name)
{:status-code 400
:errors {(keyword field-name) message}}))) |
Assertion mechanism for use inside API functions that validates individual input params.
Checks that This exception is automatically caught in the body of
| (defn checkp
{:style/indent 1}
([tst field-name message]
(when-not tst
(throw-invalid-param-exception (str field-name) message)))) |
---------------------------------------------- api-let, api->, etc. ---------------------------------------------- | |
The following all work exactly like the corresponding Clojure versions
but take an additional arg at the beginning called RESPONSE-PAIR.
RESPONSE-PAIR is of the form
| |
If (api-let [404 "Not found."] [user @current-user] (:id user)) | (defmacro do-api-let
[response-pair bindings & body]
;; so `response-pair` doesn't get evaluated more than once
(let [response-pair-symb (gensym "response-pair-")]
`(let [~response-pair-symb ~response-pair
~@(vec (apply concat (for [[binding test] (partition-all 2 bindings)]
[binding `(check ~test ~response-pair-symb)])))]
~@body))) |
GENERIC RESPONSE HELPERSThese are basically the same as the | |
GENERIC 400 RESPONSE HELPERS | (def ^:private generic-400 [400 (deferred-tru "Invalid Request.")]) |
Throw a | (defn check-400 [arg] (check arg generic-400)) |
GENERIC 404 RESPONSE HELPERS | (def ^:private generic-404 [404 (deferred-tru "Not found.")]) |
Throw a | (defn check-404 [arg] (check arg generic-404)) |
Bind a form as with | (defmacro let-404
{:style/indent 1}
[bindings & body]
`(do-api-let ~generic-404 ~bindings ~@body)) |
GENERIC 403 RESPONSE HELPERSIf you can't be bothered to write a custom error message | (defn- generic-403 [] [403 (tru "You don''t have permissions to do that.")]) |
Throw a | (defn check-403 [arg] (check arg (generic-403))) |
Throw a generic 403 (no permissions) error response. | (defn throw-403
([]
(throw-403 nil))
([e]
(throw (ex-info (tru "You don''t have permissions to do that.") {:status-code 403} e)))) |
GENERIC 500 RESPONSE HELPERSFor when you don't feel like writing something useful | (def ^:private generic-500 [500 (deferred-tru "Internal server error.")]) |
Throw a | (defn check-500 [arg] (check arg generic-500)) |
A 'No Content' response for | (def generic-204-no-content
{:status 204, :body nil}) |
--------------------------------------- DEFENDPOINT AND RELATED FUNCTIONS ---------------------------------------- | |
(s/def ::defendpoint-args (s/cat :method symbol? :route (some-fn string? sequential?) :docstr (s/? string?) :args vector? :arg->schema (s/? (s/map-of symbol? any?)) ;; any? is either a plumatic or malli schema :body (s/* any?))) | |
(defn- parse-defendpoint-args [args]
(let [parsed (s/conform ::defendpoint-args args)]
(when (= parsed ::s/invalid)
(throw (ex-info (str "Invalid defendpoint args: " (s/explain-str ::defendpoint-args args))
(s/explain-data ::defendpoint-args args))))
(let [{:keys [method route docstr args arg->schema body]} parsed
fn-name (route-fn-name method route)
route (add-route-param-schema arg->schema route)
;; eval the vals in arg->schema to make sure the actual schemas are resolved so we can document
;; their API error messages
docstr (route-dox method route docstr args
(m/map-vals #_{:clj-kondo/ignore [:discouraged-var]} eval arg->schema)
body)]
;; Don't i18n this, it's dev-facing only
(when-not docstr
(log/warn (u/format-color 'red "Warning: endpoint %s/%s does not have a docstring. Go add one."
(ns-name *ns*) fn-name)))
(assoc parsed :fn-name fn-name, :route route, :docstr docstr)))) | |
Log a warning if the request body contains any parameters not included in | (defn validate-param-values
[{method :request-method uri :uri body :body} expected-params]
(when (and (not config/is-prod?)
(map? body))
(let [extraneous-params (set/difference (set (keys body))
(set expected-params))]
(when (seq extraneous-params)
(log/warnf "Unexpected parameters at %s: %s\nPlease add them to the schema or remove them from the API client"
[method uri] (vec extraneous-params)))))) |
Convert Compojure-style HTTP method symbols (PUT, POST, etc.) to the keywords used internally by Compojure (:put, :post, ...) | (defn method-symbol->keyword
[method-symbol]
(-> method-symbol
name
u/lower-case-en
keyword)) |
Impl macro for [[defendpoint]]; don't use this directly. | (defmacro defendpoint*
[{:keys [method route fn-name docstr args body arg->schema]}]
{:pre [(or (string? route) (vector? route))]}
(let [method-kw (method-symbol->keyword method)
allowed-params (mapv keyword (keys arg->schema))
prep-route #'compojure/prepare-route
multipart? (get (meta method) :multipart false)
handler-wrapper (if multipart? mp/wrap-multipart-params identity)]
`(def ~(vary-meta fn-name
assoc
:doc docstr
:is-endpoint? true)
;; The next form is a copy of `compojure/compile-route`, with the sole addition of the call to
;; `validate-param-values`. This is because to validate the request body we need to intercept the request
;; before the destructuring takes place. I.e., we need to validate the value of `(:body request#)`, and that's
;; not available if we called `compile-route` ourselves.
(compojure/make-route
~method-kw
~(prep-route route)
(~handler-wrapper
(fn [request#]
(validate-param-values request# (quote ~allowed-params))
(compojure/let-request [~args request#]
~@body))))))) |
Define an API function. This automatically does several things:
| (defmacro defendpoint
{:arglists '([method route docstr? args schemas-map? & body])}
[& defendpoint-args]
(let [{:keys [args body arg->schema], :as defendpoint-args} (parse-defendpoint-args defendpoint-args)]
`(defendpoint* ~(assoc defendpoint-args
:body `((auto-coerce ~args ~arg->schema
~@(validate-params arg->schema)
(wrap-response-if-needed
(do ~@body)))))))) |
Like | (defmacro defendpoint-async
{:arglists '([method route docstr? args schemas-map? & body])}
[& defendpoint-args]
(let [{:keys [args body arg->schema], :as defendpoint-args} (parse-defendpoint-args defendpoint-args)]
`(defendpoint* ~(assoc defendpoint-args
:args []
:body `((fn ~args
~@(validate-params arg->schema)
~@body)))))) |
Return a sequence of all API endpoint functions defined by | (defn- namespace->api-route-fns
[nmspace]
(for [[_symb varr] (ns-publics nmspace)
:when (:is-endpoint? (meta varr))]
varr)) |
(defn- api-routes-docstring [nmspace route-fns middleware]
(str
(format "Ring routes for %s:\n%s"
(-> (ns-name nmspace)
(str/replace #"^metabase\." )
(str/replace #"\." "/"))
(u/pprint-to-str route-fns))
(when (seq middleware)
(str "\nMiddleware applied to all endpoints in this namespace:\n"
(u/pprint-to-str middleware))))) | |
Create a (api/define-routes api/+check-superuser) ; all API endpoints in this namespace will require superuser access | (defmacro define-routes
{:style/indent 0}
[& middleware]
(let [api-route-fns (namespace->api-route-fns *ns*)
routes `(compojure/routes ~@api-route-fns)
docstring (str "Routes for " *ns*)]
`(def ~(vary-meta 'routes assoc :doc (api-routes-docstring *ns* api-route-fns middleware))
~docstring
~(if (seq middleware)
`(-> ~routes ~@middleware)
routes)))) |
Wrap a Ring handler to make sure the current user is a superuser before handling any requests. (api/+check-superuser routes) | (defn +check-superuser
[handler]
(fn
([request]
(check-superuser)
(handler request))
([request respond raise]
(if-let [e (try
(check-superuser)
nil
(catch Throwable e
e))]
(raise e)
(handler request respond raise))))) |
---------------------------------------- PERMISSIONS CHECKING HELPER FNS ----------------------------------------- | |
Check whether we can read an existing | (defn read-check
{:style/indent 2}
([obj]
(check-404 obj)
(try
(check-403 (mi/can-read? obj))
(catch clojure.lang.ExceptionInfo e
(events/publish-event! :event/read-permission-failure {:user-id *current-user-id*
:object obj
:has-access false})
(throw e)))
obj)
([entity id]
(read-check (t2/select-one entity :id id)))
([entity id & other-conditions]
(read-check (apply t2/select-one entity :id id other-conditions)))) |
Check whether we can write an existing OBJ, or ENTITY with ID. If the object doesn't exist, throw a 404; if we don't have proper permissions, throw a 403. This will fetch the object if it was not already fetched, and returns OBJ if the check is successful. | (defn write-check
{:style/indent 2}
([obj]
(check-404 obj)
(try
(check-403 (mi/can-write? obj))
(catch clojure.lang.ExceptionInfo e
(events/publish-event! :event/write-permission-failure {:user-id *current-user-id*
:object obj})
(throw e)))
obj)
([entity id]
(write-check (t2/select-one entity :id id)))
([entity id & other-conditions]
(write-check (apply t2/select-one entity :id id other-conditions)))) |
NEW! Check whether the current user has permissions to CREATE a new instance of an object with properties in map This function was added years after | (defn create-check
{:added "0.32.0", :style/indent 2}
[entity m]
(try
(check-403 (mi/can-create? entity m))
(catch clojure.lang.ExceptionInfo e
(events/publish-event! :event/create-permission-failure {:model entity
:user-id *current-user-id*})
(throw e)))) |
NEW! Check whether the current user has permissions to UPDATE an object by applying a map of This function was added years after | (defn update-check
{:added "0.36.0", :style/indent 2}
[instance changes]
(try
(check-403 (mi/can-update? instance changes))
(catch clojure.lang.ExceptionInfo e
(events/publish-event! :event/update-permission-failure {:user-id *current-user-id*
:object instance})
(throw e)))) |
------------------------------------------------ OTHER HELPER FNS ------------------------------------------------ | |
Check that the | (defn check-not-archived
[object]
(u/prog1 object
(check-404 object)
(check (not (:archived object))
[404 {:message (tru "The object has been archived."), :error_code "archived"}]))) |
Check on paginated stuff that, if the limit exists, the offset exists, and vice versa. | (defn check-valid-page-params [limit offset] (check (not (and limit (not offset))) [400 (tru "When including a limit, an offset must also be included.")]) (check (not (and offset (not limit))) [400 (tru "When including an offset, a limit must also be included.")])) |
(mu/defn column-will-change? :- :boolean
"Helper for PATCH-style operations to see if a column is set to change when `object-updates` (i.e., the input to the
endpoint) is applied.
;; assuming we have a Collection 10, that is not currently archived...
(api/column-will-change? :archived (t2/select-one Collection :id 10) {:archived true}) ; -> true, because value will change
(api/column-will-change? :archived (t2/select-one Collection :id 10) {:archived false}) ; -> false, because value did not change
(api/column-will-change? :archived (t2/select-one Collection :id 10) {}) ; -> false; value not specified in updates (request body)"
[k :- :keyword object-before-updates :- :map object-updates :- :map]
(boolean
(and (contains? object-updates k)
(not= (get object-before-updates k)
(get object-updates k))))) | |
------------------------------------------ COLLECTION POSITION HELPER FNS ---------------------------------------- | |
Compare | (mu/defn reconcile-position-for-collection!
[collection-id :- [:maybe ms/PositiveInt]
old-position :- [:maybe ms/PositiveInt]
new-position :- [:maybe ms/PositiveInt]]
(let [update-fn! (fn [plus-or-minus position-update-clause]
(doseq [model '[Card Dashboard Pulse]]
(t2/update! model {:collection_id collection-id
:collection_position position-update-clause}
{:collection_position [plus-or-minus :collection_position 1]})))]
(when (not= new-position old-position)
(cond
(and (nil? new-position)
old-position)
(update-fn! :- [:> old-position])
(and new-position (nil? old-position))
(update-fn! :+ [:>= new-position])
(> new-position old-position)
(update-fn! :- [:between old-position new-position])
(< new-position old-position)
(update-fn! :+ [:between new-position old-position]))))) |
Intended to cover Cards/Dashboards/Pulses, it only asserts collection id and position, allowing extra keys | (def ^:private ModelWithPosition [:map [:collection_id [:maybe ms/PositiveInt]] [:collection_position [:maybe ms/PositiveInt]]]) |
Intended to cover Cards/Dashboards/Pulses updates. Collection id and position are optional, if they are not present, they didn't change. If they are present, they might have changed and we need to compare. | (def ^:private ModelWithOptionalPosition
[:map
[:collection_id {:optional true} [:maybe ms/PositiveInt]]
[:collection_position {:optional true} [:maybe ms/PositiveInt]]]) |
Generic function for working on cards/dashboards/pulses. Checks the before and after changes to see if there is any impact to the collection position of that model instance. If so, executes updates to fix the collection position that goes with the change. The 2-arg version of this function is used for a new card/dashboard/pulse (i.e. not updating an existing instance, but creating a new one). | (mu/defn maybe-reconcile-collection-position!
([new-model-data :- ModelWithPosition]
(maybe-reconcile-collection-position! nil new-model-data))
([{old-collection-id :collection_id, old-position :collection_position, :as _before-update} :- [:maybe ModelWithPosition]
{new-collection-id :collection_id, new-position :collection_position, :as model-updates} :- ModelWithOptionalPosition]
(let [updated-collection? (and (contains? model-updates :collection_id)
(not= old-collection-id new-collection-id))
updated-position? (and (contains? model-updates :collection_position)
(not= old-position new-position))]
(cond
;; If the collection hasn't changed, but we have a new collection position, we might need to reconcile
(and (not updated-collection?) updated-position?)
(reconcile-position-for-collection! old-collection-id old-position new-position)
;; If we have a new collection id, but no new position, reconcile the old collection, then update the new
;; collection with the existing position
(and updated-collection? (not updated-position?))
(do
(reconcile-position-for-collection! old-collection-id old-position nil)
(reconcile-position-for-collection! new-collection-id nil old-position))
;; We have a new collection id AND and new collection position
;; Update the old collection using the old position
;; Update the new collection using the new position
(and updated-collection? updated-position?)
(do
(reconcile-position-for-collection! old-collection-id old-position nil)
(reconcile-position-for-collection! new-collection-id nil new-position)))))) |
------------------------------------------ PARAM PARSING FNS ---------------------------------------- | |
Coerce a bit returned by some MySQL/MariaDB versions in some situations to Boolean. | (defn bit->boolean
[v]
(if (number? v)
(not (zero? v))
v)) |
Parse a param that could have a single value or multiple values using Used for API that can parse single value or multiple values for a param: e.g: single value: api/card/series?exclude_ids=1 multi values: api/card/series?excludeids=1&excludeids=2 Example usage: (parse-multi-values-param "1" parse-long) => [1] (parse-multi-values-param ["1" "2"] parse-long) => [1, 2] | (defn parse-multi-values-param
[xs parse-fn]
(if (sequential? xs)
(map parse-fn xs)
[(parse-fn xs)])) |
Internal functions used by | (ns metabase.api.common.internal (:require [clojure.string :as str] [clojure.walk :as walk] [colorize.core :as colorize] [malli.core :as mc] [malli.error :as me] [malli.transform :as mtx] [metabase.async.streaming-response :as streaming-response] [metabase.config :as config] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.describe :as umd] [metabase.util.malli.schema :as ms] [potemkin.types :as p.types]) (:import (metabase.async.streaming_response StreamingResponse))) |
(set! *warn-on-reflection* true) | |
(comment streaming-response/keep-me) | |
+----------------------------------------------------------------------------------------------------------------+ | DOCSTRING GENERATION | +----------------------------------------------------------------------------------------------------------------+ | |
Generate a string like | (defn- endpoint-name
([method route]
(endpoint-name *ns* method route))
([endpoint-namespace method route]
(format "%s %s%s"
(name method)
(-> (.getName (the-ns endpoint-namespace))
(str/replace #"^metabase\.api\." "/api/")
;; HACK to make sure some enterprise endpoints are consistent with the code.
;; The right way to fix this is to move them -- see #22687
;; /api/ee/sandbox/table -> /api/table, this is an override route for /api/table if sandbox is available
(str/replace #"^metabase-enterprise\.sandbox\.api\.table" "/api/table")
;; /api/ee/sandbox -> /api/mt
(str/replace #"^metabase-enterprise\.sandbox\.api\." "/api/mt/")
;; /api/ee/content-verification -> /api/moderation-review
(str/replace #"^metabase-enterprise\.content-verification\.api\." "/api/moderation-review/")
;; /api/ee/sso/sso/ -> /auth/sso
(str/replace #"^metabase-enterprise\.sso\.api\." "/auth/")
;; this should be only the replace for enterprise once we resolved #22687
(str/replace #"^metabase-enterprise\.([^\.]+)\.api\." "/api/ee/$1/"))
(if (vector? route)
(first route)
route)))) |
A version of [id :as {{:keys [datasetquery description display name visualizationsettings]} :body}] | (defn- args-form-flatten
[form]
(cond
(map? form) (args-form-flatten (mapcat (fn [[k v]]
[(args-form-flatten k) (args-form-flatten v)])
form))
(sequential? form) (mapcat args-form-flatten form)
:else [form])) |
Return a map of arg -> nil for args taken from the arguments vector. This map is merged with the ones found in the schema validation map to build a complete map of args used by the endpoint. | (defn- args-form-symbols
[form]
(into {} (for [arg (args-form-flatten form)
:when (and (symbol? arg)
(not= arg 'body))]
{arg nil}))) |
Generate the docstring for | (defn- dox-for-schema
[schema route-str]
(try (umd/describe schema)
(catch Exception _
(ex-data
(when (and schema config/is-dev?) ;; schema is nil for any var without a schema. That's ok!
(log/warn
(u/format-color 'red (str "Invalid Malli Schema: %s defined at %s")
(u/pprint-to-str schema)
(u/add-period route-str)))))
""))) |
Return the appropriate name for this | (defn- param-name
[param-symb schema]
(or (when (record? schema)
(:api-param-name schema))
(name param-symb))) |
Generate the | (defn- format-route-schema-dox
[param-symb->schema route-str]
;; these are here
(when (seq param-symb->schema)
(str "\n\n### PARAMS:\n\n"
(str/join "\n\n"
(for [[param-symb schema] param-symb->schema]
(format "* **`%s`** %s"
(param-name param-symb schema)
(dox-for-schema schema route-str))))))) |
Return a markdown-formatted string to be used as documentation for a | (defn- format-route-dox
[route-str docstr param->schema]
(str (format "## `%s`" route-str)
(when (seq docstr)
(str "\n\n" (u/add-period docstr)))
(format-route-schema-dox param->schema route-str))) |
Does the BODY of this | (defn- contains-superuser-check?
[body]
(let [body (set body)]
(or (contains? body '(check-superuser))
(contains? body '(api/check-superuser))))) |
Prints a markdown route doc for defendpoint | (defn route-dox
[method route docstr args param->schema body]
(format-route-dox (endpoint-name method route)
(str (u/add-period docstr) (when (contains-superuser-check? body)
"\n\nYou must be a superuser to do this."))
(merge (args-form-symbols args)
param->schema))) |
+----------------------------------------------------------------------------------------------------------------+ | AUTO-PARSING + ROUTE TYPING | +----------------------------------------------------------------------------------------------------------------+ | |
Parse | (defn parse-int
[^String value]
(try (Integer/parseInt value)
(catch NumberFormatException _
(throw (ex-info (tru "Not a valid integer: ''{0}''" value) {:status-code 400}))))) |
Map of :route-param-regex Regex pattern that should be used for params in Compojure route forms :parser Function that should be used to parse args | (def ^:dynamic *auto-parse-types*
{:int {:route-param-regex #"[0-9]+"
:parser 'metabase.api.common.internal/parse-int}
:uuid {:route-param-regex u/uuid-regex
:parser nil}}) |
Sequence of | (def ^:private ^:const auto-parse-arg-name-patterns [[#"^uuid$" :uuid] [#"^session_id$" :uuid] [#"^[\w-_]*id$" :int]]) |
Return a key into (arg-type :id) -> :int | (defn arg-type
[arg]
(some (fn [[pattern type]]
(when (re-find pattern (name arg))
type))
auto-parse-arg-name-patterns)) |
TYPIFY-ROUTE | |
If keyword (route-param-regex :id) -> [:id #"[0-9]+"] | (defn route-param-regex
[arg]
(some->> (arg-type arg)
*auto-parse-types*
:route-param-regex
(vector arg))) |
Return a sequence of keywords for URL args in string (route-arg-keywords "/:id/cards") -> [:id] | (defn route-arg-keywords
[route]
(->> (re-seq #":([\w-]+)" route)
(map second)
(map keyword))) |
Note: this is called in a macro context, so it can potentially be passed a symbol that evaluates to a schema. | (defn- ->matching-regex
[schema]
(let [schema-type (try (mc/type schema)
(catch clojure.lang.ExceptionInfo _
(mc/type #_:clj-kondo/ignore (eval schema))))]
[schema-type
(condp = schema-type
;; can use any regex directly
:re (first (try (mc/children schema)
(catch clojure.lang.ExceptionInfo _
(mc/children #_:clj-kondo/ignore (eval schema)))))
:keyword #"[\S]+"
'pos-int? #"[0-9]+"
:int #"-?[0-9]+"
'int? #"-?[0-9]+"
:uuid u/uuid-regex
'uuid? u/uuid-regex
nil)])) |
(def ^:private no-regex-schemas #{(mc/type ms/NonBlankString)
(mc/type (mc/schema [:maybe ms/PositiveInt]))
(mc/type [:enum "a" "b"])
:fn
:string}) | |
Expand a (add-route-param-schema '{id :int} "/:id/card") -> ["/:id/card" :id #"[0-9]+"] (add-route-param-schema {} "/:id/card") -> "/:id/card" | (defn add-route-param-schema
[arg->schema route]
(if (vector? route)
route
(let [[wildcard & wildcards]
(->> (for [[k schema] arg->schema
:when (re-find (re-pattern (str ":" k)) route)
:let [[schema-type re] (->matching-regex schema)]]
(if re
[route (keyword k) re]
(when (and config/is-dev? (not (contains? no-regex-schemas schema-type)))
(let [overview (str "Warning: missing route-param regex for schema: "
route " " [k schema])
fix (str "Either add `" (pr-str schema-type) "` to "
"metabase.api.common.internal/->matching-regex or "
"metabase.api.common.internal/no-regex-schemas.")]
(log/warn (colorize/red overview))
(log/warn (colorize/green fix))))))
(remove nil?))]
(cond
;; multiple hits -> tack them onto the original route shape.
wildcards (vec (reduce into wildcard (mapv #(drop 1 %) wildcards)))
wildcard wildcard
:else route)))) |
ROUTE ARG AUTO PARSING | |
Given an | (defn let-form-for-arg
[arg-symbol]
(when (symbol? arg-symbol)
(some-> (arg-type arg-symbol) ; :int
*auto-parse-types* ; {:parser ... }
:parser ; Integer/parseInt
((fn [parser] `(when ~arg-symbol (~parser ~arg-symbol)))) ; (when id (Integer/parseInt id))
((partial vector arg-symbol))))) ; [id (Integer/parseInt id)] |
Create a | (defmacro auto-parse
{:style/indent 1}
[args & body]
(let [let-forms (->> args
(mapcat let-form-for-arg)
(filter identity))]
`(let [~@let-forms]
~@body))) |
+----------------------------------------------------------------------------------------------------------------+ | AUTO-COERCION | +----------------------------------------------------------------------------------------------------------------+ | |
Transformer used on values coming over the API via defendpoint. | (def defendpoint-transformer (mtx/transformer (mtx/string-transformer) (mtx/json-transformer))) |
(defn- extract-symbols [in]
(let [*symbols (atom [])]
(walk/postwalk
(fn [x] (when (symbol? x) (swap! *symbols conj x)) x)
in)
@*symbols)) | |
(defn- mauto-let-form [arg->schema arg-symbol]
(when arg->schema
(when-let [schema (arg->schema arg-symbol)]
`[~arg-symbol (mc/decode ~schema ~arg-symbol defendpoint-transformer)]))) | |
Create a | (defmacro auto-coerce
{:style/indent 1}
[args arg->schema & body]
(let [let-forms (->> args
extract-symbols
(mapcat #(mauto-let-form arg->schema %))
(remove nil?))]
`(let [~@let-forms] ~@body))) |
+----------------------------------------------------------------------------------------------------------------+ | PARAM VALIDATION | +----------------------------------------------------------------------------------------------------------------+ | |
Validate a parameter against its respective malli schema, or throw an Exception. | (defn validate-param
[field-name value schema]
(when-not (mc/validate schema value)
(throw (ex-info (tru "Invalid m field: {0}" field-name)
{:status-code 400
:errors {(keyword field-name) (umd/describe schema)}
:specific-errors {(keyword field-name)
(-> schema
(mc/explain value)
me/with-spell-checking
(me/humanize {:wrap mu/humanize-include-value}))}})))) |
Generate a series of | (defn validate-params
[param->schema]
(for [[param schema] param->schema]
`(validate-param '~param ~param ~schema))) |
+----------------------------------------------------------------------------------------------------------------+ | MISC. OTHER FNS USED BY DEFENDPOINT | +----------------------------------------------------------------------------------------------------------------+ | |
Generate a symbol suitable for use as the name of an API endpoint fn. Name is just (route-fn-name GET "/:id") ;-> GET_:id | (defn route-fn-name
[method route]
;; if we were passed a vector like [":id" :id #"[0-9+]"] only use first part
(let [route (if (vector? route) (first route) route)]
(-> (str (name method) route)
(^String .replace "/" "_")
symbol))) |
Protocol for transformations that should be done to the value returned by a | (p.types/defprotocol+ EndpointResponse
(wrap-response-if-needed [this]
"Transform the value returned by a `defendpoint` form as needed, e.g. by adding `:status` and `:body`.")) |
(extend-protocol EndpointResponse
Object
(wrap-response-if-needed [this]
{:status 200, :body this})
nil
(wrap-response-if-needed [_]
{:status 204, :body nil})
StreamingResponse
(wrap-response-if-needed [this]
this)
clojure.lang.IPersistentMap
(wrap-response-if-needed [m]
(if (and (:status m) (contains? m :body))
m
{:status 200, :body m}))) | |
(ns metabase.api.common.validation (:require [clojure.string :as str] [metabase.api.common :as api] [metabase.config :as config] [metabase.embed.settings :as embed.settings] [metabase.plugins.classloader :as classloader] [metabase.public-settings :as public-settings] [metabase.public-settings.premium-features :as premium-features] [metabase.util.i18n :refer [tru]])) | |
TODO: figure out what other functions to move here from metabase.api.common | |
Check that the | (defn check-public-sharing-enabled
[]
(api/check (public-settings/enable-public-sharing)
[400 (tru "Public sharing is not enabled.")])) |
Is embedding of Cards or Objects (secured access via | (defn check-embedding-enabled
[]
(api/check (embed.settings/enable-embedding)
[400 (tru "Embedding is not enabled.")])) |
If | (defn check-has-application-permission
([perm-type]
(check-has-application-permission perm-type true))
([perm-type require-superuser?]
(if-let [f (and (premium-features/enable-advanced-permissions?)
(resolve 'metabase-enterprise.advanced-permissions.common/current-user-has-application-permissions?))]
(api/check-403 (f perm-type))
(when require-superuser?
(api/check-superuser))))) |
Check if advanced permissions is enabled to use permission types such as :group-manager or :application-permissions. | (defn check-advanced-permissions-enabled
[perm-type]
(api/check (premium-features/enable-advanced-permissions?)
[402 (tru "The {0} permissions functionality is only enabled if you have a premium token with the advanced-permissions feature."
(str/replace (name perm-type) "-" " "))])) |
If | (defn check-group-manager
([]
(check-group-manager true))
([require-superuser?]
(if (premium-features/enable-advanced-permissions?)
(api/check-403 (or api/*is-superuser?* api/*is-group-manager?*))
(when require-superuser?
(api/check-superuser))))) |
If | (defn check-manager-of-group
([group-or-id]
(check-manager-of-group group-or-id true))
([group-or-id require-superuser?]
(when config/ee-available?
(classloader/require 'metabase-enterprise.advanced-permissions.common))
(if-let [f (and (premium-features/enable-advanced-permissions?)
(resolve 'metabase-enterprise.advanced-permissions.common/current-user-is-manager-of-group?))]
(api/check-403 (or api/*is-superuser?* (f group-or-id)))
(when require-superuser?
(api/check-superuser))))) |
/api/dashboard endpoints. | (ns metabase.api.dashboard (:require [cheshire.core :as json] [clojure.set :as set] [compojure.core :refer [DELETE GET POST PUT]] [medley.core :as m] [metabase.actions.execution :as actions.execution] [metabase.analytics.snowplow :as snowplow] [metabase.api.common :as api] [metabase.api.common.validation :as validation] [metabase.api.dataset :as api.dataset] [metabase.automagic-dashboards.populate :as populate] [metabase.events :as events] [metabase.mbql.normalize :as mbql.normalize] [metabase.mbql.schema :as mbql.s] [metabase.mbql.util :as mbql.u] [metabase.models.action :as action] [metabase.models.card :as card :refer [Card]] [metabase.models.collection :as collection] [metabase.models.collection.root :as collection.root] [metabase.models.dashboard :as dashboard :refer [Dashboard]] [metabase.models.dashboard-card :as dashboard-card :refer [DashboardCard]] [metabase.models.dashboard-tab :as dashboard-tab] [metabase.models.field :refer [Field]] [metabase.models.interface :as mi] [metabase.models.params :as params] [metabase.models.params.chain-filter :as chain-filter] [metabase.models.params.custom-values :as custom-values] [metabase.models.query :as query :refer [Query]] [metabase.models.query.permissions :as query-perms] [metabase.models.revision :as revision] [metabase.models.revision.last-edit :as last-edit] [metabase.models.table :refer [Table]] [metabase.query-processor.dashboard :as qp.dashboard] [metabase.query-processor.error-type :as qp.error-type] [metabase.query-processor.middleware.constraints :as qp.constraints] [metabase.query-processor.middleware.permissions :as qp.perms] [metabase.query-processor.pivot :as qp.pivot] [metabase.query-processor.util :as qp.util] [metabase.related :as related] [metabase.util :as u] [metabase.util.i18n :refer [deferred-tru tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [steffan-westcott.clj-otel.api.trace.span :as span] [toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
(defn- dashboards-list [filter-option]
(as-> (t2/select :model/Dashboard {:where [:and (case (or (keyword filter-option) :all)
(:all :archived) true
:mine [:= :creator_id api/*current-user-id*])
[:= :archived (= (keyword filter-option) :archived)]]
:order-by [:%lower.name]}) <>
(t2/hydrate <> :creator)
(filter mi/can-read? <>))) | |
/ | (api/defendpoint ^:deprecated GET
"This endpoint is currently unused by the Metabase frontend and may be out of date with the rest of the application.
It only exists for backwards compatibility and may be removed in the future.
Get `Dashboards`. With filter option `f` (default `all`), restrict results as follows:
* `all` - Return all Dashboards.
* `mine` - Return Dashboards created by the current user.
* `archived` - Return Dashboards that have been archived. (By default, these are *excluded*.)"
[f]
{f [:maybe [:enum "all" "mine" "archived"]]}
(let [dashboards (dashboards-list f)
edit-infos (:dashboard (last-edit/fetch-last-edited-info {:dashboard-ids (map :id dashboards)}))]
(into []
(map (fn [{:keys [id] :as dashboard}]
(if-let [edit-info (get edit-infos id)]
(assoc dashboard :last-edit-info edit-info)
dashboard)))
dashboards))) |
Get dashboard details for the complete dashboard, including tabs, dashcards, params, etc. | (defn- hydrate-dashboard-details
[{dashboard-id :id :as dashboard}]
;; I'm a bit worried that this is an n+1 situation here. The cards can be batch hydrated i think because they
;; have a hydration key and an id. moderation_reviews currently aren't batch hydrated but i'm worried they
;; cannot be in this situation
(span/with-span!
{:name "hydrate-dashboard-details"
:attributes {:dashboard/id dashboard-id}}
(t2/hydrate dashboard [:dashcards
[:card [:moderation_reviews :moderator_details]]
[:card :can_write]
:series
:dashcard/action
:dashcard/linkcard-info]
:tabs
:collection_authority_level
:can_write
:param_fields
:param_values
[:collection :is_personal]))) |
/ | (api/defendpoint POST
"Create a new Dashboard."
[:as {{:keys [name description parameters cache_ttl collection_id collection_position], :as _dashboard} :body}]
{name ms/NonBlankString
parameters [:maybe [:sequential ms/Parameter]]
description [:maybe :string]
cache_ttl [:maybe ms/PositiveInt]
collection_id [:maybe ms/PositiveInt]
collection_position [:maybe ms/PositiveInt]}
;; if we're trying to save the new dashboard in a Collection make sure we have permissions to do that
(collection/check-write-perms-for-collection collection_id)
(let [dashboard-data {:name name
:description description
:parameters (or parameters [])
:creator_id api/*current-user-id*
:cache_ttl cache_ttl
:collection_id collection_id
:collection_position collection_position}
dash (t2/with-transaction [_conn]
;; Adding a new dashboard at `collection_position` could cause other dashboards in this collection to change
;; position, check that and fix up if needed
(api/maybe-reconcile-collection-position! dashboard-data)
;; Ok, now save the Dashboard
(first (t2/insert-returning-instances! :model/Dashboard dashboard-data)))]
(events/publish-event! :event/dashboard-create {:object dash :user-id api/*current-user-id*})
(snowplow/track-event! ::snowplow/dashboard-created api/*current-user-id* {:dashboard-id (u/the-id dash)})
(-> dash
hydrate-dashboard-details
collection.root/hydrate-root-collection
(assoc :last-edit-info (last-edit/edit-information-for-user @api/*current-user*))))) |
-------------------------------------------- Hiding Unreadable Cards --------------------------------------------- | |
If CARD is unreadable, replace it with an object containing only its | (defn- hide-unreadable-card
[card]
(when card
(if (mi/can-read? card)
card
(select-keys card [:id])))) |
Replace the | (defn- hide-unreadable-cards
[dashboard]
(update dashboard :dashcards (fn [dashcards]
(vec (for [dashcard dashcards]
(-> dashcard
(update :card hide-unreadable-card)
(update :series (partial mapv hide-unreadable-card)))))))) |
------------------------------------------ Query Average Duration Info ------------------------------------------- | |
Adding the average execution time to all of the Cards in a Dashboard efficiently is somewhat involved. There are a few things that make this tricky:
Here's an overview of the approach used to efficiently add the info:
| |
Return a tuple of possible hashes that would be associated with executions of CARD. The first is the hash of the
query dictionary as-is; the second is one with the | (defn- card->query-hashes
[{:keys [dataset_query]}]
(u/ignore-exceptions
[(qp.util/query-hash dataset_query)
(qp.util/query-hash (assoc dataset_query :constraints (qp.constraints/default-query-constraints)))])) |
Return a sequence of all the query hashes for this | (defn- dashcard->query-hashes
[{:keys [card series]}]
(reduce concat
(card->query-hashes card)
(for [card series]
(card->query-hashes card)))) |
Return a sequence of all the query hashes used in a | (defn- dashcards->query-hashes
[dashcards]
(apply concat (for [dashcard dashcards]
(dashcard->query-hashes dashcard)))) |
Given some query | (defn- hashes->hash-vec->avg-time
[hashes]
(when (seq hashes)
(into {} (for [[k v] (t2/select-fn->fn :query_hash :average_execution_time Query :query_hash [:in hashes])]
{(vec k) v})))) |
Add | (defn- add-query-average-duration-to-card
[card hash-vec->avg-time]
(assoc card :query_average_duration (some (fn [query-hash]
(hash-vec->avg-time (vec query-hash)))
(card->query-hashes card)))) |
Add | (defn- add-query-average-duration-to-dashcards
([dashcards]
(add-query-average-duration-to-dashcards dashcards (hashes->hash-vec->avg-time (dashcards->query-hashes dashcards))))
([dashcards hash-vec->avg-time]
(for [dashcard dashcards]
(-> dashcard
(update :card add-query-average-duration-to-card hash-vec->avg-time)
(update :series (fn [series]
(for [card series]
(add-query-average-duration-to-card card hash-vec->avg-time)))))))) |
Add a | (defn add-query-average-durations [dashboard] (update dashboard :dashcards add-query-average-duration-to-dashcards)) |
Get Dashboard with ID. | (defn- get-dashboard
[id]
(span/with-span!
{:name "get-dashboard"
:attributes {:dashboard/id id}}
(-> (t2/select-one :model/Dashboard :id id)
api/read-check
hydrate-dashboard-details
collection.root/hydrate-root-collection
api/check-not-archived
hide-unreadable-cards
add-query-average-durations))) |
Returns a map of which cards we need to copy and which are not to be copied. The | (defn- cards-to-copy
[dashcards]
(letfn [(split-cards [{:keys [card series] :as db-card}]
(cond
(nil? (:card_id db-card)) ; text card
{}
;; cards without permissions are just a map with an :id from [[hide-unreadable-card]]
(not (mi/model card))
{:retain nil, :discard (into [card] series)}
(mi/can-read? card)
(let [{writable true unwritable false} (group-by (comp boolean mi/can-read?)
series)]
{:retain (into [card] writable), :discard unwritable})
;; if you can't write the base, we don't have anywhere to put the series
:else
{:discard (into [card] series)}))]
(reduce (fn [acc db-card]
(let [{:keys [retain discard]} (split-cards db-card)]
(-> acc
(update :copy merge (m/index-by :id retain))
(update :discard concat discard))))
{:copy {}
:discard []}
dashcards))) |
Takes a dashboard id, and duplicates the cards both on the dashboard's cards and dashcardseries. Returns a map of {:copied {old-card-id duplicated-card} :uncopied [card]} so that the new dashboard can adjust accordingly. | (defn- duplicate-cards
[dashboard dest-coll-id]
(let [same-collection? (= (:collection_id dashboard) dest-coll-id)
{:keys [copy discard]} (cards-to-copy (:dashcards dashboard))]
(reduce (fn [m [id card]]
(assoc-in m
[:copied id]
(if (:dataset card)
card
(card/create-card!
(cond-> (assoc card :collection_id dest-coll-id)
same-collection?
(update :name #(str % " - " (tru "Duplicate"))))
@api/*current-user*
;; creating cards from a transaction. wait until tx complete to signal event
true))))
{:copied {}
:uncopied discard}
copy))) |
(defn- duplicate-tabs
[new-dashboard existing-tabs]
(let [new-tab-ids (t2/insert-returning-pks! :model/DashboardTab
(for [tab existing-tabs]
(-> tab
(assoc :dashboard_id (:id new-dashboard))
(dissoc :id :entity_id :created_at :updated_at))))]
(zipmap (map :id existing-tabs) new-tab-ids))) | |
Update dashcards in a dashboard for copying. If the dashboard has tabs, fix up the tab ids in dashcards to point to the new tabs. Then if shallow copy, return the cards. If deep copy, replace ids with id from the newly-copied cards. If there is no new id, it means user lacked curate permissions for the cards collections and it is omitted. Dashboard-id is only needed for useful errors. | (defn update-cards-for-copy
[dashboard-id dashcards deep? id->new-card id->new-tab-id]
(when (and deep? (nil? id->new-card))
(throw (ex-info (tru "No copied card information found")
{:user-id api/*current-user-id*
:dashboard-id dashboard-id})))
(let [dashcards (if (seq id->new-tab-id)
(map #(assoc % :dashboard_tab_id (id->new-tab-id (:dashboard_tab_id %)))
dashcards)
dashcards)]
(if-not deep?
dashcards
(keep (fn [dashboard-card]
(cond
;; text cards need no manipulation
(nil? (:card_id dashboard-card))
dashboard-card
;; if we didn't duplicate, it doesn't go in the dashboard
(not (id->new-card (:card_id dashboard-card)))
nil
:else
(let [new-id (fn [id]
(-> id id->new-card :id))]
(-> dashboard-card
(update :card_id new-id)
(assoc :card (-> dashboard-card :card_id id->new-card))
(m/update-existing :parameter_mappings
(fn [pms]
(keep (fn [pm]
(m/update-existing pm :card_id new-id))
pms)))
(m/update-existing :series
(fn [series]
(keep (fn [card]
(when-let [id' (new-id (:id card))]
(assoc card :id id')))
series)))))))
dashcards)))) |
/:from-dashboard-id/copy | (api/defendpoint POST
"Copy a Dashboard."
[from-dashboard-id :as {{:keys [name description collection_id collection_position
is_deep_copy], :as _dashboard} :body}]
{from-dashboard-id [:maybe ms/PositiveInt]
name [:maybe ms/NonBlankString]
description [:maybe :string]
collection_id [:maybe ms/PositiveInt]
collection_position [:maybe ms/PositiveInt]
is_deep_copy [:maybe :boolean]}
;; if we're trying to save the new dashboard in a Collection make sure we have permissions to do that
(collection/check-write-perms-for-collection collection_id)
(let [existing-dashboard (get-dashboard from-dashboard-id)
dashboard-data {:name (or name (:name existing-dashboard))
:description (or description (:description existing-dashboard))
:parameters (or (:parameters existing-dashboard) [])
:creator_id api/*current-user-id*
:collection_id collection_id
:collection_position collection_position}
new-cards (atom nil)
dashboard (t2/with-transaction [_conn]
;; Adding a new dashboard at `collection_position` could cause other dashboards in this
;; collection to change position, check that and fix up if needed
(api/maybe-reconcile-collection-position! dashboard-data)
;; Ok, now save the Dashboard
(let [dash (first (t2/insert-returning-instances! :model/Dashboard dashboard-data))
{id->new-card :copied uncopied :uncopied}
(when is_deep_copy
(duplicate-cards existing-dashboard collection_id))
id->new-tab-id (when-let [existing-tabs (seq (:tabs existing-dashboard))]
(duplicate-tabs dash existing-tabs))]
(reset! new-cards (vals id->new-card))
(when-let [dashcards (seq (update-cards-for-copy from-dashboard-id
(:dashcards existing-dashboard)
is_deep_copy
id->new-card
id->new-tab-id))]
(api/check-500 (dashboard/add-dashcards! dash dashcards)))
(cond-> dash
(seq uncopied)
(assoc :uncopied uncopied))))]
(snowplow/track-event! ::snowplow/dashboard-created api/*current-user-id* {:dashboard-id (u/the-id dashboard)})
;; must signal event outside of tx so cards are visible from other threads
(when-let [newly-created-cards (seq @new-cards)]
(doseq [card newly-created-cards]
(events/publish-event! :event/card-create {:object card :user-id api/*current-user-id*})))
(events/publish-event! :event/dashboard-create {:object dashboard :user-id api/*current-user-id*})
dashboard)) |
--------------------------------------------- Fetching/Updating/Etc. --------------------------------------------- | |
/:id | (api/defendpoint GET
"Get Dashboard with ID."
[id]
{id ms/PositiveInt}
(let [dashboard (get-dashboard id)]
(events/publish-event! :event/dashboard-read {:object dashboard :user-id api/*current-user-id*})
(last-edit/with-last-edit-info dashboard :dashboard))) |
You must be a superuser to change the value of | (defn- check-allowed-to-change-embedding
[dash-before-update dash-updates]
(when (or (api/column-will-change? :enable_embedding dash-before-update dash-updates)
(api/column-will-change? :embedding_params dash-before-update dash-updates))
(validation/check-embedding-enabled)
(api/check-superuser))) |
/:id TODO - We can probably remove this in the near future since it should no longer be needed now that we're going to
be setting | (api/defendpoint DELETE
"Delete a Dashboard.
This will remove also any questions/models/segments/metrics that use this database."
[id]
{id ms/PositiveInt}
(log/warn (str "DELETE /api/dashboard/:id is deprecated. Instead of deleting a Dashboard, you should change its "
"`archived` value via PUT /api/dashboard/:id."))
(let [dashboard (api/write-check :model/Dashboard id)]
(t2/delete! :model/Dashboard :id id)
(events/publish-event! :event/dashboard-delete {:object dashboard :user-id api/*current-user-id*}))
api/generic-204-no-content) |
(defn- param-target->field-id [target query]
(when-let [field-clause (params/param-target->field-clause target {:dataset_query query})]
(mbql.u/match-one field-clause [:field (id :guard integer?) _] id))) | |
Starting in 0.41.0, you must have data permissions in order to add or modify a DashboardCard parameter mapping. TODO -- should we only check new or modified mappings? | (mu/defn ^:private check-parameter-mapping-permissions
{:added "0.41.0"}
[parameter-mappings :- [:sequential dashboard-card/ParamMapping]]
(when (seq parameter-mappings)
;; calculate a set of all Field IDs referenced by parameter mappings; then from those Field IDs calculate a set of
;; all Table IDs to which those Fields belong. This is done in a batched fashion so we can avoid N+1 query issues
;; if there happen to be a lot of parameters
(let [card-ids (into #{}
(comp (map :card-id)
(remove nil?))
parameter-mappings)]
(when (seq card-ids)
(let [card-id->query (t2/select-pk->fn :dataset_query Card :id [:in card-ids])
field-ids (set (for [{:keys [target card-id]} parameter-mappings
:when card-id
:let [query (or (card-id->query card-id)
(throw (ex-info (tru "Card {0} does not exist or does not have a valid query."
card-id)
{:status-code 404
:card-id card-id})))
field-id (param-target->field-id target query)]
:when field-id]
field-id))
table-ids (when (seq field-ids)
(t2/select-fn-set :table_id Field :id [:in field-ids]))
table-id->database-id (when (seq table-ids)
(t2/select-pk->fn :db_id Table :id [:in table-ids]))]
(doseq [table-id table-ids
:let [database-id (table-id->database-id table-id)]]
;; check whether we'd actually be able to query this Table (do we have ad-hoc data perms for it?)
(when-not (query-perms/can-query-table? database-id table-id)
(throw (ex-info (tru "You must have data permissions to add a parameter referencing the Table {0}."
(pr-str (t2/select-one-fn :name Table :id table-id)))
{:status-code 403
:database-id database-id
:table-id table-id
:actual-permissions @api/*current-user-permissions-set*}))))))))) |
Returns a map of DashboardCard ID -> parameter mappings for a Dashboard of the form { | (defn- existing-parameter-mappings
[dashboard-id]
(m/map-vals (fn [mappings]
(into #{} (map #(select-keys % [:target :parameter_id])) mappings))
(t2/select-pk->fn :parameter_mappings DashboardCard :dashboard_id dashboard-id))) |
In 0.41.0+ you now require data permissions for the Table in question to add or modify Dashboard parameter mappings. Check that the current user has the appropriate permissions. Don't check any parameter mappings that already exist for this Dashboard -- only check permissions for new or modified ones. | (defn- check-updated-parameter-mapping-permissions
[dashboard-id dashcards]
(let [dashcard-id->existing-mappings (existing-parameter-mappings dashboard-id)
existing-mapping? (fn [dashcard-id mapping]
(let [[mapping] (mi/normalize-parameters-list [mapping])
existing-mappings (get dashcard-id->existing-mappings dashcard-id)]
(contains? existing-mappings (select-keys mapping [:target :parameter_id]))))
new-mappings (for [{mappings :parameter_mappings, dashcard-id :id} dashcards
mapping mappings
:when (not (existing-mapping? dashcard-id mapping))]
(assoc mapping :dashcard-id dashcard-id))
;; need to add the appropriate `:card-id` for all the new mappings we're going to check.
dashcard-id->card-id (when (seq new-mappings)
(t2/select-pk->fn :card_id DashboardCard
:dashboard_id dashboard-id
:id [:in (set (map :dashcard-id new-mappings))]))
new-mappings (for [{:keys [dashcard-id], :as mapping} new-mappings]
(assoc mapping :card-id (get dashcard-id->card-id dashcard-id)))]
(check-parameter-mapping-permissions new-mappings))) |
(defn- create-dashcards!
[dashboard dashcards]
(doseq [{:keys [card_id]} dashcards
:when (pos-int? card_id)]
(api/check-not-archived (api/read-check Card card_id)))
(check-parameter-mapping-permissions (for [{:keys [card_id parameter_mappings]} dashcards
mapping parameter_mappings]
(assoc mapping :card-id card_id)))
(api/check-500 (dashboard/add-dashcards! dashboard dashcards))) | |
(defn- update-dashcards! [dashboard dashcards] (check-updated-parameter-mapping-permissions (:id dashboard) dashcards) ;; transform the dashcard data to the format of the DashboardCard model ;; so update-dashcards! can compare them with existing dashcards (dashboard/update-dashcards! dashboard (map dashboard-card/from-parsed-json dashcards)) dashcards) | |
(defn- delete-dashcards! [dashcard-ids]
(let [dashboard-cards (t2/select DashboardCard :id [:in dashcard-ids])]
(dashboard-card/delete-dashboard-cards! dashcard-ids)
dashboard-cards)) | |
(defn- do-update-dashcards!
[dashboard current-cards new-cards]
(let [{:keys [to-create to-update to-delete]} (u/classify-changes current-cards new-cards)]
(when (seq to-update)
(update-dashcards! dashboard to-update))
{:deleted-dashcards (when (seq to-delete)
(delete-dashcards! (map :id to-delete)))
:created-dashcards (when (seq to-create)
(create-dashcards! dashboard to-create))})) | |
(def ^:private UpdatedDashboardCard
[:map
;; id can be negative, it indicates a new card and BE should create them
[:id int?]
[:size_x ms/PositiveInt]
[:size_y ms/PositiveInt]
[:row ms/IntGreaterThanOrEqualToZero]
[:col ms/IntGreaterThanOrEqualToZero]
[:parameter_mappings {:optional true} [:maybe [:sequential [:map
[:parameter_id ms/NonBlankString]
[:target :any]]]]]
[:series {:optional true} [:maybe [:sequential map?]]]]) | |
(def ^:private UpdatedDashboardTab [:map ;; id can be negative, it indicates a new card and BE should create them [:id ms/Int] [:name ms/NonBlankString]]) | |
(defn- track-dashcard-and-tab-events!
[{dashboard-id :id :as dashboard}
{:keys [created-dashcards deleted-dashcards
created-tab-ids deleted-tab-ids total-num-tabs]}]
;; Dashcard events
(when (seq deleted-dashcards)
(events/publish-event! :event/dashboard-remove-cards
{:object dashboard :user-id api/*current-user-id* :dashcards deleted-dashcards}))
(when (seq created-dashcards)
(events/publish-event! :event/dashboard-add-cards
{:object dashboard :user-id api/*current-user-id* :dashcards created-dashcards})
(for [{:keys [card_id]} created-dashcards
:when (pos-int? card_id)]
(snowplow/track-event! ::snowplow/question-added-to-dashboard
api/*current-user-id*
{:dashboard-id dashboard-id :question-id card_id :user-id api/*current-user-id*})))
;; Tabs events
(when (seq deleted-tab-ids)
(snowplow/track-event! ::snowplow/dashboard-tab-deleted
api/*current-user-id*
{:dashboard-id dashboard-id
:num-tabs (count deleted-tab-ids)
:total-num-tabs total-num-tabs}))
(when (seq created-tab-ids)
(snowplow/track-event! ::snowplow/dashboard-tab-created
api/*current-user-id*
{:dashboard-id dashboard-id
:num-tabs (count created-tab-ids)
:total-num-tabs total-num-tabs}))) | |
Updates a Dashboard. Designed to be reused by PUT /api/dashboard/:id and PUT /api/dashboard/:id/cards | (defn- update-dashboard
[id {:keys [dashcards tabs] :as dash-updates}]
(span/with-span!
{:name "update-dashboard"
:attributes {:dashboard/id id}}
(let [current-dash (api/write-check Dashboard id)
changes-stats (atom nil)
;; tabs are always sent in production as well when dashcards are updated, but there are lots of
;; tests that exclude it. so this only checks for dashcards
update-dashcards-and-tabs? (contains? dash-updates :dashcards)]
(collection/check-allowed-to-change-collection current-dash dash-updates)
(check-allowed-to-change-embedding current-dash dash-updates)
(api/check-500
(do
(t2/with-transaction [_conn]
;; If the dashboard has an updated position, or if the dashboard is moving to a new collection, we might need to
;; adjust the collection position of other dashboards in the collection
(api/maybe-reconcile-collection-position! current-dash dash-updates)
(when-let [updates (not-empty
(u/select-keys-when
dash-updates
:present #{:description :position :collection_id :collection_position :cache_ttl}
:non-nil #{:name :parameters :caveats :points_of_interest :show_in_getting_started :enable_embedding
:embedding_params :archived :auto_apply_filters}))]
(t2/update! Dashboard id updates))
(when update-dashcards-and-tabs?
(when (not (false? (:archived false)))
(api/check-not-archived current-dash))
(let [{current-dashcards :dashcards
current-tabs :tabs
:as hydrated-current-dash} (t2/hydrate current-dash [:dashcards :series :card] :tabs)
_ (when (and (seq current-tabs)
(not (every? #(some? (:dashboard_tab_id %)) dashcards)))
(throw (ex-info (tru "This dashboard has tab, makes sure every card has a tab")
{:status-code 400})))
new-tabs (map-indexed (fn [idx tab] (assoc tab :position idx)) tabs)
{:keys [old->new-tab-id
deleted-tab-ids]
:as tabs-changes-stats} (dashboard-tab/do-update-tabs! (:id current-dash) current-tabs new-tabs)
deleted-tab-ids (set deleted-tab-ids)
current-dashcards (remove (fn [dashcard]
(contains? deleted-tab-ids (:dashboard_tab_id dashcard)))
current-dashcards)
new-dashcards (cond->> dashcards
;; fixup the temporary tab ids with the real ones
(seq old->new-tab-id)
(map (fn [card]
(if-let [real-tab-id (get old->new-tab-id (:dashboard_tab_id card))]
(assoc card :dashboard_tab_id real-tab-id)
card))))
dashcards-changes-stats (do-update-dashcards! hydrated-current-dash current-dashcards new-dashcards)]
(reset! changes-stats
(merge
(select-keys tabs-changes-stats [:created-tab-ids :deleted-tab-ids :total-num-tabs])
(select-keys dashcards-changes-stats [:created-dashcards :deleted-dashcards]))))))
true))
(let [dashboard (t2/select-one :model/Dashboard id)]
;; skip publishing the event if it's just a change in its collection position
(when-not (= #{:collection_position}
(set (keys dash-updates)))
(events/publish-event! :event/dashboard-update {:object dashboard :user-id api/*current-user-id*}))
(track-dashcard-and-tab-events! dashboard @changes-stats)
(-> dashboard
hydrate-dashboard-details
(assoc :last-edit-info (last-edit/edit-information-for-user @api/*current-user*))))))) |
/:id | (api/defendpoint PUT
"Update a Dashboard, and optionally the `dashcards` and `tabs` of a Dashboard. The request body should be a JSON object with the same
structure as the response from `GET /api/dashboard/:id`."
[id :as {{:keys [description name parameters caveats points_of_interest show_in_getting_started enable_embedding
embedding_params position archived collection_id collection_position cache_ttl dashcards tabs]
:as dash-updates} :body}]
{id ms/PositiveInt
name [:maybe ms/NonBlankString]
description [:maybe :string]
caveats [:maybe :string]
points_of_interest [:maybe :string]
show_in_getting_started [:maybe :boolean]
enable_embedding [:maybe :boolean]
embedding_params [:maybe ms/EmbeddingParams]
parameters [:maybe [:sequential ms/Parameter]]
position [:maybe ms/PositiveInt]
archived [:maybe :boolean]
collection_id [:maybe ms/PositiveInt]
collection_position [:maybe ms/PositiveInt]
cache_ttl [:maybe ms/PositiveInt]
dashcards [:maybe (ms/maps-with-unique-key [:sequential UpdatedDashboardCard] :id)]
tabs [:maybe (ms/maps-with-unique-key [:sequential UpdatedDashboardTab] :id)]}
(update-dashboard id dash-updates)) |
/:id/cards | (api/defendpoint PUT
"(DEPRECATED -- Use the `PUT /api/dashboard/:id` endpoint instead.)
Update `Cards` and `Tabs` on a Dashboard. Request body should have the form:
{:cards [{:id ... ; DashboardCard ID
:size_x ...
:size_y ...
:row ...
:col ...
:parameter_mappings ...
:series [{:id 123
...}]}
...]
:tabs [{:id ... ; DashboardTab ID
:name ...}]}"
[id :as {{:keys [cards tabs]} :body}]
{id ms/PositiveInt
cards (ms/maps-with-unique-key [:sequential UpdatedDashboardCard] :id)
;; tabs should be required in production, making it optional because lots of
;; e2e tests curerntly doesn't include it
tabs [:maybe (ms/maps-with-unique-key [:sequential UpdatedDashboardTab] :id)]}
(log/warn
"DELETE /api/dashboard/:id/cards is deprecated. Use PUT /api/dashboard/:id instead.")
(let [dashboard (update-dashboard id {:dashcards cards :tabs tabs})]
{:cards (:dashcards dashboard)
:tabs (:tabs dashboard)})) |
/:id/revisions | (api/defendpoint GET
"Fetch `Revisions` for Dashboard with ID."
[id]
{id ms/PositiveInt}
(api/read-check :model/Dashboard id)
(revision/revisions+details :model/Dashboard id)) |
/:id/revert | (api/defendpoint POST
"Revert a Dashboard to a prior `Revision`."
[id :as {{:keys [revision_id]} :body}]
{id ms/PositiveInt
revision_id ms/PositiveInt}
(api/write-check :model/Dashboard id)
(revision/revert!
{:entity :model/Dashboard
:id id
:user-id api/*current-user-id*
:revision-id revision_id})) |
----------------------------------------------- Sharing is Caring ------------------------------------------------ | |
/:dashboard-id/public_link | (api/defendpoint POST
"Generate publicly-accessible links for this Dashboard. Returns UUID to be used in public links. (If this
Dashboard has already been shared, it will return the existing public link rather than creating a new one.) Public
sharing must be enabled."
[dashboard-id]
{dashboard-id ms/PositiveInt}
(api/check-superuser)
(validation/check-public-sharing-enabled)
(api/check-not-archived (api/read-check :model/Dashboard dashboard-id))
{:uuid (or (t2/select-one-fn :public_uuid :model/Dashboard :id dashboard-id)
(u/prog1 (str (random-uuid))
(t2/update! :model/Dashboard dashboard-id
{:public_uuid <>
:made_public_by_id api/*current-user-id*})))}) |
/:dashboard-id/public_link | (api/defendpoint DELETE
"Delete the publicly-accessible link to this Dashboard."
[dashboard-id]
{dashboard-id ms/PositiveInt}
(validation/check-has-application-permission :setting)
(validation/check-public-sharing-enabled)
(api/check-exists? :model/Dashboard :id dashboard-id, :public_uuid [:not= nil], :archived false)
(t2/update! :model/Dashboard dashboard-id
{:public_uuid nil
:made_public_by_id nil})
{:status 204, :body nil}) |
/public | (api/defendpoint GET "Fetch a list of Dashboards with public UUIDs. These dashboards are publicly-accessible *if* public sharing is enabled." [] (validation/check-has-application-permission :setting) (validation/check-public-sharing-enabled) (t2/select [:model/Dashboard :name :id :public_uuid], :public_uuid [:not= nil], :archived false)) |
/embeddable | (api/defendpoint GET "Fetch a list of Dashboards where `enable_embedding` is `true`. The dashboards can be embedded using the embedding endpoints and a signed JWT." [] (validation/check-has-application-permission :setting) (validation/check-embedding-enabled) (t2/select [:model/Dashboard :name :id], :enable_embedding true, :archived false)) |
/:id/related | (api/defendpoint GET
"Return related entities."
[id]
{id ms/PositiveInt}
(-> (t2/select-one :model/Dashboard :id id) api/read-check related/related)) |
---------------------------------------------- Transient dashboards ---------------------------------------------- | |
/save/collection/:parent-collection-id | (api/defendpoint POST
"Save a denormalized description of dashboard into collection with ID `:parent-collection-id`."
[parent-collection-id :as {dashboard :body}]
{parent-collection-id ms/PositiveInt}
(collection/check-write-perms-for-collection parent-collection-id)
(let [dashboard (dashboard/save-transient-dashboard! dashboard parent-collection-id)]
(events/publish-event! :event/dashboard-create {:object dashboard :user-id api/*current-user-id*})
dashboard)) |
/save | (api/defendpoint POST
"Save a denormalized description of dashboard."
[:as {dashboard :body}]
(let [parent-collection-id (if api/*is-superuser?*
(:id (populate/get-or-create-root-container-collection))
(t2/select-one-fn :id 'Collection
:personal_owner_id api/*current-user-id*))
dashboard (dashboard/save-transient-dashboard! dashboard parent-collection-id)]
(events/publish-event! :event/dashboard-create {:object dashboard :user-id api/*current-user-id*})
dashboard)) |
------------------------------------- Chain-filtering param value endpoints -------------------------------------- | |
How many results to return when chain filtering | (def ^:const result-limit 1000) |
Fetch the (get-template-tag [:template-tag :company] some-dashcard) ; -> [:field 100 nil] | (defn- get-template-tag
[dimension card]
(when-let [[_ tag] (mbql.u/check-clause :template-tag dimension)]
(get-in card [:dataset_query :native :template-tags (u/qualified-name tag)]))) |
(defn- param-type->op [type]
(if (get-in mbql.s/parameter-types [type :operator])
(keyword (name type))
:=)) | |
(mu/defn ^:private param->fields
[{:keys [mappings] :as param} :- mbql.s/Parameter]
(for [{:keys [target] {:keys [card]} :dashcard} mappings
:let [[_ dimension] (->> (mbql.normalize/normalize-tokens target :ignore-path)
(mbql.u/check-clause :dimension))]
:when dimension
:let [ttag (get-template-tag dimension card)
dimension (condp mbql.u/is-clause? dimension
:field dimension
:expression dimension
:template-tag (:dimension ttag)
(log/error "cannot handle this dimension" {:dimension dimension}))
field-id (or
;; Get the field id from the field-clause if it contains it. This is the common case
;; for mbql queries.
(mbql.u/match-one dimension [:field (id :guard integer?) _] id)
;; Attempt to get the field clause from the model metadata corresponding to the field.
;; This is the common case for native queries in which mappings from original columns
;; have been performed using model metadata.
(:id (qp.util/field->field-info dimension (:result_metadata card))))]
:when field-id]
{:field-id field-id
:op (param-type->op (:type param))
:options (merge (:options ttag)
(:options param))})) | |
(mu/defn ^:private chain-filter-constraints :- chain-filter/Constraints
[dashboard constraint-param-key->value]
(vec (for [[param-key value] constraint-param-key->value
:let [param (get-in dashboard [:resolved-params param-key])]
:when param
field (param->fields param)]
(assoc field :value value)))) | |
Get filter values when only field-refs (e.g. | (defn filter-values-from-field-refs
[dashboard param-key]
(let [dashboard (t2/hydrate dashboard :resolved-params)
param (get-in dashboard [:resolved-params param-key])
results (for [{:keys [target] {:keys [card]} :dashcard} (:mappings param)
:let [[_ dimension] (->> (mbql.normalize/normalize-tokens target :ignore-path)
(mbql.u/check-clause :dimension))]
:when dimension]
(custom-values/values-from-card card dimension))]
(when-some [values (seq (distinct (mapcat :values results)))]
(let [has_more_values (boolean (some true? (map :has_more_values results)))]
{:values (cond->> values
(seq values)
(sort-by (case (count (first values))
2 second
1 first)))
:has_more_values has_more_values})))) |
(mu/defn chain-filter :- ms/FieldValuesResult
"C H A I N filters!
Used to query for values that populate chained filter dropdowns and text search boxes."
([dashboard param-key constraint-param-key->value]
(chain-filter dashboard param-key constraint-param-key->value nil))
([dashboard :- ms/Map
param-key :- ms/NonBlankString
constraint-param-key->value :- ms/Map
query :- [:maybe ms/NonBlankString]]
(let [dashboard (t2/hydrate dashboard :resolved-params)
constraints (chain-filter-constraints dashboard constraint-param-key->value)
param (get-in dashboard [:resolved-params param-key])
field-ids (into #{} (map :field-id (param->fields param)))]
(if (empty? field-ids)
(or (filter-values-from-field-refs dashboard param-key)
(throw (ex-info (tru "Parameter {0} does not have any Fields associated with it" (pr-str param-key))
{:param (get (:resolved-params dashboard) param-key)
:status-code 400})))
(try
(let [results (map (if (seq query)
#(chain-filter/chain-filter-search % constraints query :limit result-limit)
#(chain-filter/chain-filter % constraints :limit result-limit))
field-ids)
values (distinct (mapcat :values results))
has_more_values (boolean (some true? (map :has_more_values results)))]
;; results can come back as [[v] ...] *or* as [[orig remapped] ...]. Sort by remapped value if it's there
{:values (cond->> values
(seq values)
(sort-by (case (count (first values))
2 second
1 first)))
:has_more_values has_more_values})
(catch clojure.lang.ExceptionInfo e
(if (= (:type (u/all-ex-data e)) qp.error-type/missing-required-permissions)
(api/throw-403 e)
(throw e)))))))) | |
Fetch values for a parameter. The source of values could be: - static-list: user defined values list - card: values is result of running a card - nil: chain-filter | (mu/defn param-values
([dashboard param-key constraint-param-key->value]
(param-values dashboard param-key constraint-param-key->value nil))
([dashboard :- :map
param-key :- ms/NonBlankString
constraint-param-key->value :- :map
query :- [:maybe ms/NonBlankString]]
(let [dashboard (t2/hydrate dashboard :resolved-params)
param (get (:resolved-params dashboard) param-key)]
(when-not param
(throw (ex-info (tru "Dashboard does not have a parameter with the ID {0}" (pr-str param-key))
{:resolved-params (keys (:resolved-params dashboard))
:status-code 400})))
(custom-values/parameter->values
param
query
(fn [] (chain-filter dashboard param-key constraint-param-key->value query)))))) |
/:id/params/:param-key/values | (api/defendpoint GET
"Fetch possible values of the parameter whose ID is `:param-key`. If the values come directly from a query, optionally
restrict these values by passing query parameters like `other-parameter=value` e.g.
;; fetch values for Dashboard 1 parameter 'abc' that are possible when parameter 'def' is set to 100
GET /api/dashboard/1/params/abc/values?def=100"
[id param-key :as {constraint-param-key->value :query-params}]
{id ms/PositiveInt}
(let [dashboard (api/read-check :model/Dashboard id)]
;; If a user can read the dashboard, then they can lookup filters. This also works with sandboxing.
(binding [qp.perms/*param-values-query* true]
(param-values dashboard param-key constraint-param-key->value)))) |
/:id/params/:param-key/search/:query | (api/defendpoint GET
"Fetch possible values of the parameter whose ID is `:param-key` that contain `:query`. Optionally restrict
these values by passing query parameters like `other-parameter=value` e.g.
;; fetch values for Dashboard 1 parameter 'abc' that contain 'Cam' and are possible when parameter 'def' is set
;; to 100
GET /api/dashboard/1/params/abc/search/Cam?def=100
Currently limited to first 1000 results."
[id param-key query :as {constraint-param-key->value :query-params}]
{id ms/PositiveInt
query ms/NonBlankString}
(let [dashboard (api/read-check :model/Dashboard id)]
;; If a user can read the dashboard, then they can lookup filters. This also works with sandboxing.
(binding [qp.perms/*param-values-query* true]
(param-values dashboard param-key constraint-param-key->value query)))) |
/params/valid-filter-fields | (api/defendpoint GET
"Utility endpoint for powering Dashboard UI. Given some set of `filtered` Field IDs (presumably Fields used in
parameters) and a set of `filtering` Field IDs that will be used to restrict values of `filtered` Fields, for each
`filtered` Field ID return the subset of `filtering` Field IDs that would actually be used in a chain filter query
with these Fields.
e.g. in a chain filter query like
GET /api/dashboard/10/params/PARAM_1/values?PARAM_2=100
Assume `PARAM_1` maps to Field 1 and `PARAM_2` maps to Fields 2 and 3. The underlying MBQL query may or may not
filter against Fields 2 and 3, depending on whether an FK relationship that lets us create a join against Field 1
can be found. You can use this endpoint to determine which of those Fields is actually used:
GET /api/dashboard/params/valid-filter-fields?filtered=1&filtering=2&filtering=3
;; ->
{1 [2 3]}
Results are returned as a map of
`filtered` Field ID -> subset of `filtering` Field IDs that would be used in chain filter query"
[:as {{:keys [filtered filtering]} :params}]
{filtered [:or ms/IntGreaterThanOrEqualToZero
[:+ ms/IntGreaterThanOrEqualToZero]]
filtering [:maybe [:or ms/IntGreaterThanOrEqualToZero
[:+ ms/IntGreaterThanOrEqualToZero]]]}
(let [filtered-field-ids (if (sequential? filtered) (set filtered) #{filtered})
filtering-field-ids (if (sequential? filtering) (set filtering) #{filtering})]
(doseq [field-id (set/union filtered-field-ids filtering-field-ids)]
(api/read-check Field field-id))
(into {} (for [field-id filtered-field-ids]
[field-id (sort (chain-filter/filterable-field-ids field-id filtering-field-ids))])))) |
Schema for a parameter map with an string | (def ParameterWithID
(mu/with-api-error-message
[:and
[:map
[:id ms/NonBlankString]]
[:map-of :keyword :any]]
(deferred-tru "value must be a parameter map with an 'id' key"))) |
---------------------------------- Executing the action associated with a Dashcard ------------------------------- | |
/:dashboard-id/dashcard/:dashcard-id/execute | (api/defendpoint GET
"Fetches the values for filling in execution parameters. Pass PK parameters and values to select."
[dashboard-id dashcard-id parameters]
{dashboard-id ms/PositiveInt
dashcard-id ms/PositiveInt
parameters ms/JSONString}
(api/read-check :model/Dashboard dashboard-id)
(actions.execution/fetch-values
(api/check-404 (action/dashcard->action dashcard-id))
(json/parse-string parameters))) |
/:dashboard-id/dashcard/:dashcard-id/execute | (api/defendpoint POST
"Execute the associated Action in the context of a `Dashboard` and `DashboardCard` that includes it.
`parameters` should be the mapped dashboard parameters with values.
`extra_parameters` should be the extra, user entered parameter values."
[dashboard-id dashcard-id :as {{:keys [parameters], :as _body} :body}]
{dashboard-id ms/PositiveInt
dashcard-id ms/PositiveInt
parameters [:maybe [:map-of :keyword :any]]}
(api/read-check :model/Dashboard dashboard-id)
;; Undo middleware string->keyword coercion
(actions.execution/execute-dashcard! dashboard-id dashcard-id (update-keys parameters name))) |
---------------------------------- Running the query associated with a Dashcard ---------------------------------- | |
/:dashboard-id/dashcard/:dashcard-id/card/:card-id/query | (api/defendpoint POST
"Run the query associated with a Saved Question (`Card`) in the context of a `Dashboard` that includes it."
[dashboard-id dashcard-id card-id :as {{:keys [parameters], :as body} :body}]
{dashboard-id ms/PositiveInt
dashcard-id ms/PositiveInt
card-id ms/PositiveInt
parameters [:maybe [:sequential ParameterWithID]]}
(m/mapply qp.dashboard/run-query-for-dashcard-async
(merge
body
{:dashboard-id dashboard-id
:card-id card-id
:dashcard-id dashcard-id}))) |
/:dashboard-id/dashcard/:dashcard-id/card/:card-id/query/:export-format | (api/defendpoint POST
"Run the query associated with a Saved Question (`Card`) in the context of a `Dashboard` that includes it, and return
its results as a file in the specified format.
`parameters` should be passed as query parameter encoded as a serialized JSON string (this is because this endpoint
is normally used to power 'Download Results' buttons that use HTML `form` actions)."
[dashboard-id dashcard-id card-id export-format :as {{:keys [parameters], :as request-parameters} :params}]
{dashboard-id ms/PositiveInt
dashcard-id ms/PositiveInt
card-id ms/PositiveInt
parameters [:maybe ms/JSONString]
export-format api.dataset/ExportFormat}
(m/mapply qp.dashboard/run-query-for-dashcard-async
(merge
request-parameters
{:dashboard-id dashboard-id
:card-id card-id
:dashcard-id dashcard-id
:export-format export-format
:parameters (json/parse-string parameters keyword)
:context (api.dataset/export-format->context export-format)
:constraints nil
;; TODO -- passing this `:middleware` map is a little repetitive, need to think of a way to not have to
;; specify this all over the codebase any time we want to do a query with an export format. Maybe this
;; should be the default if `export-format` isn't `:api`?
:middleware {:process-viz-settings? true
:skip-results-metadata? true
:ignore-cached-results? true
:format-rows? false
:js-int-to-string? false}}))) |
/pivot/:dashboard-id/dashcard/:dashcard-id/card/:card-id/query | (api/defendpoint POST
"Run a pivot table query for a specific DashCard."
[dashboard-id dashcard-id card-id :as {{:keys [parameters], :as body} :body}]
{dashboard-id ms/PositiveInt
dashcard-id ms/PositiveInt
card-id ms/PositiveInt
parameters [:maybe [:sequential ParameterWithID]]}
(m/mapply qp.dashboard/run-query-for-dashcard-async
(merge
body
{:dashboard-id dashboard-id
:card-id card-id
:dashcard-id dashcard-id
:qp-runner qp.pivot/run-pivot-query}))) |
(api/define-routes) | |
/api/database endpoints. | (ns metabase.api.database
(:require
[clojure.string :as str]
[compojure.core :refer [DELETE GET POST PUT]]
[medley.core :as m]
[metabase.analytics.snowplow :as snowplow]
[metabase.api.common :as api]
[metabase.api.table :as api.table]
[metabase.config :as config]
[metabase.db.connection :as mdb.connection]
[metabase.db.query :as mdb.query]
[metabase.driver :as driver]
[metabase.driver.ddl.interface :as ddl.i]
[metabase.driver.h2 :as h2]
[metabase.driver.util :as driver.u]
[metabase.events :as events]
[metabase.lib.schema.id :as lib.schema.id]
[metabase.mbql.util :as mbql.u]
[metabase.models.card :refer [Card]]
[metabase.models.collection :as collection :refer [Collection]]
[metabase.models.database
:as database
:refer [Database protected-password]]
[metabase.models.field :refer [Field readable-fields-only]]
[metabase.models.interface :as mi]
[metabase.models.permissions :as perms]
[metabase.models.persisted-info :as persisted-info]
[metabase.models.secret :as secret]
[metabase.models.setting :as setting :refer [defsetting]]
[metabase.models.table :refer [Table]]
[metabase.plugins.classloader :as classloader]
[metabase.public-settings :as public-settings]
[metabase.public-settings.premium-features :as premium-features]
[metabase.sample-data :as sample-data]
[metabase.sync.analyze :as analyze]
[metabase.sync.field-values :as field-values]
[metabase.sync.schedules :as sync.schedules]
[metabase.sync.sync-metadata :as sync-metadata]
[metabase.sync.util :as sync-util]
[metabase.task.persist-refresh :as task.persist-refresh]
[metabase.upload :as upload]
[metabase.util :as u]
[metabase.util.cron :as u.cron]
[metabase.util.honey-sql-2 :as h2x]
[metabase.util.i18n :refer [deferred-tru trs tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
Schema for a valid database engine name, e.g. | (def DBEngineString
(mu/with-api-error-message
[:and
ms/NonBlankString
[:fn
{:error/message "Valid database engine"}
#(u/ignore-exceptions (driver/the-driver %))]]
(deferred-tru "value must be a valid database engine."))) |
----------------------------------------------- GET /api/database ------------------------------------------------ | |
(defn- add-tables [dbs]
(let [db-id->tables (group-by :db_id (filter mi/can-read? (t2/select Table
:active true
:db_id [:in (map :id dbs)]
:visibility_type nil
{:order-by [[:%lower.schema :asc]
[:%lower.display_name :asc]]})))]
(for [db dbs]
(assoc db :tables (get db-id->tables (:id db) []))))) | |
(mu/defn ^:private add-native-perms-info :- [:maybe
[:sequential
[:map
[:native_permissions [:enum :write :none]]]]]
"For each database in DBS add a `:native_permissions` field describing the current user's permissions for running
native (e.g. SQL) queries. Will be either `:write` or `:none`. `:write` means you can run ad-hoc native queries,
and save new Cards with native queries; `:none` means you can do neither.
For the curious: the use of `:write` and `:none` is mainly for legacy purposes, when we had data-access-based
permissions; there was a specific option where you could give a Perms Group permissions to run existing Cards with
native queries, but not to create new ones. With the advent of what is currently being called 'Space-Age
Permissions', all Cards' permissions are based on their parent Collection, removing the need for native read perms."
[dbs :- [:maybe [:sequential :map]]]
(for [db dbs]
(assoc db :native_permissions (if (perms/set-has-full-permissions? @api/*current-user-permissions-set*
(perms/adhoc-native-query-path (u/the-id db)))
:write
:none)))) | |
(defn- card-database-supports-nested-queries? [{{database-id :database, :as database} :dataset_query, :as _card}]
(when database-id
(when-let [driver (driver.u/database->driver database-id)]
(driver/database-supports? driver :nested-queries database)))) | |
We know a card has ambiguous columns if any of the columns that come back end in SELECT name FROM ( SELECT x.name, y.name FROM x LEFT JOIN y on x.id = y.id ) would be ambiguous. Too many things break when attempting to use a query like this. In the future, this may be
supported, but it will likely require rewriting the source SQL query to add appropriate aliases (this is even
trickier if the source query uses | (defn- card-has-ambiguous-columns?
[{result-metadata :result_metadata, dataset-query :dataset_query}]
(and (= (:type dataset-query) :native)
(some (partial re-find #"_2$")
(map (comp name :name) result-metadata)))) |
Since cumulative count and cumulative sum aggregations are done in Clojure-land we can't use Cards that use queries
with those aggregations as source queries. This function determines whether | (defn- card-uses-unnestable-aggregation?
[{{{aggregations :aggregation} :query} :dataset_query}]
(mbql.u/match aggregations #{:cum-count :cum-sum})) |
Does | (defn card-can-be-used-as-source-query?
[card]
(and (card-database-supports-nested-queries? card)
(not (or (card-uses-unnestable-aggregation? card)
(card-has-ambiguous-columns? card))))) |
(defn- ids-of-dbs-that-support-source-queries []
(set (filter (fn [db-id]
(try
(when-let [db (t2/select-one Database :id db-id)]
(driver/database-supports? (:engine db) :nested-queries db))
(catch Throwable e
(log/error e (tru "Error determining whether Database supports nested queries")))))
(t2/select-pks-set Database)))) | |
Fetch the Cards that can be used as source queries (e.g. presented as virtual tables). Since Cards can be either
| (defn- source-query-cards
[question-type & {:keys [additional-constraints xform], :or {xform identity}}]
{:pre [(#{:card :dataset} question-type)]}
(when-let [ids-of-dbs-that-support-source-queries (not-empty (ids-of-dbs-that-support-source-queries))]
(transduce
(comp (map (partial mi/do-after-select Card))
(filter card-can-be-used-as-source-query?)
xform)
(completing conj #(t2/hydrate % :collection))
[]
(mdb.query/reducible-query {:select [:name :description :database_id :dataset_query :id :collection_id :result_metadata
[{:select [:status]
:from [:moderation_review]
:where [:and
[:= :moderated_item_type "card"]
[:= :moderated_item_id :report_card.id]
[:= :most_recent true]]
:order-by [[:id :desc]]
:limit 1}
:moderated_status]]
:from [:report_card]
:where (into [:and
[:not= :result_metadata nil]
[:= :archived false]
[:= :dataset (= question-type :dataset)]
[:in :database_id ids-of-dbs-that-support-source-queries]
(collection/visible-collection-ids->honeysql-filter-clause
(collection/permissions-set->visible-collection-ids
@api/*current-user-permissions-set*))]
additional-constraints)
:order-by [[:%lower.name :asc]]})))) |
Truthy if a single Card that can be used as a source query exists. | (defn- source-query-cards-exist? [question-type] (seq (source-query-cards question-type :xform (take 1)))) |
Return a sequence of 'virtual' Table metadata for eligible Cards.
(This takes the Cards from | (defn- cards-virtual-tables
[question-type & {:keys [include-fields?]}]
(for [card (source-query-cards question-type)]
(api.table/card->virtual-table card :include-fields? include-fields?))) |
(defn- saved-cards-virtual-db-metadata [question-type & {:keys [include-tables? include-fields?]}]
(when (public-settings/enable-nested-queries)
(cond-> {:name (trs "Saved Questions")
:id lib.schema.id/saved-questions-virtual-database-id
:features #{:basic-aggregations}
:is_saved_questions true}
include-tables? (assoc :tables (cards-virtual-tables question-type
:include-fields? include-fields?))))) | |
"Virtual" tables for saved cards simulate the db->schema->table hierarchy by doing fake-db->collection->card | (defn- add-saved-questions-virtual-database [dbs & options]
(let [virtual-db-metadata (apply saved-cards-virtual-db-metadata :card options)]
;; only add the 'Saved Questions' DB if there are Cards that can be used
(cond-> dbs
(and (source-query-cards-exist? :card) virtual-db-metadata) (concat [virtual-db-metadata])))) |
Filters the provided list of databases by data model perms, returning only the databases for which the current user can fully or partially edit the data model. If the user does not have data access for any databases, returns only the name and ID of these databases, removing all other fields. | (defn- filter-databases-by-data-model-perms
[dbs]
(let [filtered-dbs
(if-let [f (when config/ee-available?
(classloader/require 'metabase-enterprise.advanced-permissions.common)
(resolve 'metabase-enterprise.advanced-permissions.common/filter-databases-by-data-model-perms))]
(f dbs)
dbs)]
(map
(fn [db] (if (mi/can-read? db)
db
(select-keys db [:id :name :tables])))
filtered-dbs))) |
Given a DB, checks that current-user has any data model editing perms for the DB. If yes, returns the DB, with its tables also filtered by data model editing perms. If it does not, throws a permissions exception. | (defn- check-db-data-model-perms
[db]
(let [filtered-dbs (filter-databases-by-data-model-perms [db])]
(api/check-403 (first filtered-dbs)))) |
Are uploads supported for this database? | (defn- uploadable-db? [db] (driver/database-supports? (driver.u/database->driver db) :uploads db)) |
Add an entry to each DB about whether the user can upload to it. | (defn- add-can-upload-to-dbs
[dbs]
(let [uploads-db-id (public-settings/uploads-database-id)]
(for [db dbs]
(assoc db :can_upload (and (= (:id db) uploads-db-id)
(upload/can-create-upload? db (public-settings/uploads-schema-name))))))) |
(defn- dbs-list
[& {:keys [include-tables?
include-saved-questions-db?
include-saved-questions-tables?
include-editable-data-model?
include-analytics?
exclude-uneditable-details?
include-only-uploadable?]}]
(let [dbs (t2/select Database (merge {:order-by [:%lower.name :%lower.engine]}
(when-not include-analytics?
{:where [:= :is_audit false]})))
filter-by-data-access? (not (or include-editable-data-model? exclude-uneditable-details?))]
(cond-> (add-native-perms-info dbs)
include-tables? add-tables
true add-can-upload-to-dbs
include-editable-data-model? filter-databases-by-data-model-perms
exclude-uneditable-details? (#(filter mi/can-write? %))
filter-by-data-access? (#(filter mi/can-read? %))
include-saved-questions-db? (add-saved-questions-virtual-database :include-tables? include-saved-questions-tables?)
;; Perms checks for uploadable DBs are handled by exclude-uneditable-details? (see below)
include-only-uploadable? (#(filter uploadable-db? %))))) | |
/ | (api/defendpoint GET
"Fetch all `Databases`.
* `include=tables` means we should hydrate the Tables belonging to each DB. Default: `false`.
* `saved` means we should include the saved questions virtual database. Default: `false`.
* `include_editable_data_model` will only include DBs for which the current user has data model editing
permissions. (If `include=tables`, this also applies to the list of tables in each DB). Should only be used if
Enterprise Edition code is available the advanced-permissions feature is enabled.
* `exclude_uneditable_details` will only include DBs for which the current user can edit the DB details. Has no
effect unless Enterprise Edition code is available and the advanced-permissions feature is enabled.
* `include_only_uploadable` will only include DBs into which Metabase can insert new data."
[include saved include_editable_data_model exclude_uneditable_details include_only_uploadable include_analytics]
{include (mu/with-api-error-message
[:maybe [:= "tables"]]
(deferred-tru "include must be either empty or the value 'tables'"))
include_analytics [:maybe :boolean]
saved [:maybe :boolean]
include_editable_data_model [:maybe :boolean]
exclude_uneditable_details [:maybe :boolean]
include_only_uploadable [:maybe :boolean]}
(let [include-tables? (= include "tables")
include-saved-questions-tables? (and saved include-tables?)
only-editable? (or include_only_uploadable exclude_uneditable_details)
db-list-res (or (dbs-list :include-tables? include-tables?
:include-saved-questions-db? saved
:include-saved-questions-tables? include-saved-questions-tables?
:include-editable-data-model? include_editable_data_model
:exclude-uneditable-details? only-editable?
:include-analytics? include_analytics
:include-only-uploadable? include_only_uploadable)
[])]
{:data db-list-res
:total (count db-list-res)})) |
--------------------------------------------- GET /api/database/:id ---------------------------------------------- | |
(mu/defn ^:private expanded-schedules [db :- (mi/InstanceOf Database)]
{:cache_field_values (u.cron/cron-string->schedule-map (:cache_field_values_schedule db))
:metadata_sync (u.cron/cron-string->schedule-map (:metadata_sync_schedule db))}) | |
Add 'expanded' versions of the cron schedules strings for DB in a format that is appropriate for frontend consumption. | (defn- add-expanded-schedules [db] (assoc db :schedules (expanded-schedules db))) |
(defn- filter-sensitive-fields [fields] (remove #(= :sensitive (:visibility_type %)) fields)) | |
If URL param | (defn- get-database-hydrate-include
[db include]
(if-not include
db
(-> (t2/hydrate db (case include
"tables" :tables
"tables.fields" [:tables [:fields [:target :has_field_values] :has_field_values]]))
(update :tables (fn [tables]
(cond->> tables
; filter hidden tables
true (filter (every-pred (complement :visibility_type) mi/can-read?))
; filter hidden fields
(= include "tables.fields") (map #(update % :fields filter-sensitive-fields)))))))) |
Add an entry about whether the user can upload to this DB. | (defn- add-can-upload
[db]
(assoc db :can_upload (and (= (u/the-id db) (public-settings/uploads-database-id))
(upload/can-create-upload? db (public-settings/uploads-schema-name))))) |
/:id | (api/defendpoint GET
"Get a single Database with `id`. Optionally pass `?include=tables` or `?include=tables.fields` to include the Tables
belonging to this database, or the Tables and Fields, respectively. If the requestor has write permissions for the DB
(i.e. is an admin or has data model permissions), then certain inferred secret values will also be included in the
returned details (see [[metabase.models.secret/expand-db-details-inferred-secret-values]] for full details).
Passing include_editable_data_model will only return tables for which the current user has data model editing
permissions, if Enterprise Edition code is available and a token with the advanced-permissions feature is present.
In addition, if the user has no data access for the DB (aka block permissions), it will return only the DB name, ID
and tables, with no additional metadata."
[id include include_editable_data_model exclude_uneditable_details]
{id ms/PositiveInt
include [:maybe [:enum "tables" "tables.fields"]]}
(let [include-editable-data-model? (Boolean/parseBoolean include_editable_data_model)
exclude-uneditable-details? (Boolean/parseBoolean exclude_uneditable_details)
filter-by-data-access? (not (or include-editable-data-model? exclude-uneditable-details?))
database (api/check-404 (t2/select-one Database :id id))]
(cond-> database
filter-by-data-access? api/read-check
exclude-uneditable-details? api/write-check
true add-expanded-schedules
true (get-database-hydrate-include include)
true add-can-upload
include-editable-data-model? check-db-data-model-perms
(mi/can-write? database) (->
secret/expand-db-details-inferred-secret-values
(assoc :can-manage true))))) |
List of models that are used to report usage on a database. | (def ^:private database-usage-models [:question :dataset :metric :segment]) |
A Honey SQL expression that is never true. 1 = 2 | (def ^:private always-false-hsql-expr [:= [:inline 1] [:inline 2]]) |
Query that will returns the number of | (defmulti ^:private database-usage-query
{:arglists '([model database-id table-ids])}
(fn [model _database-id _table-ids] (keyword model))) |
(defmethod database-usage-query :question
[_ db-id _table-ids]
{:select [[:%count.* :question]]
:from [:report_card]
:where [:and
[:= :database_id db-id]
[:= :dataset false]]}) | |
(defmethod database-usage-query :dataset
[_ db-id _table-ids]
{:select [[:%count.* :dataset]]
:from [:report_card]
:where [:and
[:= :database_id db-id]
[:= :dataset true]]}) | |
(defmethod database-usage-query :metric
[_ _db-id table-ids]
{:select [[:%count.* :metric]]
:from [:metric]
:where (if table-ids
[:in :table_id table-ids]
always-false-hsql-expr)}) | |
(defmethod database-usage-query :segment
[_ _db-id table-ids]
{:select [[:%count.* :segment]]
:from [:segment]
:where (if table-ids
[:in :table_id table-ids]
always-false-hsql-expr)}) | |
/:id/usage_info | (api/defendpoint GET
"Get usage info for a database.
Returns a map with keys are models and values are the number of entities that use this database."
[id]
{id ms/PositiveInt}
(api/check-superuser)
(api/check-404 (t2/exists? Database :id id))
(let [table-ids (t2/select-pks-set Table :db_id id)]
(first (mdb.query/query
{:select [:*]
:from (for [model database-usage-models
:let [query (database-usage-query model id table-ids)]
:when query]
[query model])})))) |
----------------------------------------- GET /api/database/:id/metadata ----------------------------------------- | |
Since the normal | (api/defendpoint GET ["/:virtual-db/metadata" :virtual-db (re-pattern (str lib.schema.id/saved-questions-virtual-database-id))] "Endpoint that provides metadata for the Saved Questions 'virtual' database. Used for fooling the frontend and allowing it to treat the Saved Questions virtual DB just like any other database." [] (saved-cards-virtual-db-metadata :card :include-tables? true, :include-fields? true)) |
(defn- db-metadata [id include-hidden? include-editable-data-model? remove_inactive?]
(let [db (-> (if include-editable-data-model?
(api/check-404 (t2/select-one Database :id id))
(api/read-check Database id))
(t2/hydrate [:tables [:fields [:target :has_field_values] :has_field_values] :segments :metrics]))
db (if include-editable-data-model?
;; We need to check data model perms after hydrating tables, since this will also filter out tables for
;; which the *current-user* does not have data model perms
(check-db-data-model-perms db)
db)]
(-> db
(update :tables (if include-hidden?
identity
(fn [tables]
(->> tables
(remove :visibility_type)
(map #(update % :fields filter-sensitive-fields))))))
(update :tables (fn [tables]
(if-not include-editable-data-model?
;; If we're filtering by data model perms, table perm checks were already done by
;; check-db-data-model-perms
(filter mi/can-read? tables)
tables)))
(update :tables (fn [tables]
(for [table tables]
(-> table
(update :segments (partial filter mi/can-read?))
(update :metrics (partial filter mi/can-read?))))))
(update :tables (if remove_inactive?
(fn [tables]
(filter :active tables))
identity))))) | |
/:id/metadata | (api/defendpoint GET
"Get metadata about a `Database`, including all of its `Tables` and `Fields`. Returns DB, fields, and field values.
By default only non-hidden tables and fields are returned. Passing include_hidden=true includes them.
Passing include_editable_data_model will only return tables for which the current user has data model editing
permissions, if Enterprise Edition code is available and a token with the advanced-permissions feature is present.
In addition, if the user has no data access for the DB (aka block permissions), it will return only the DB name, ID
and tables, with no additional metadata."
[id include_hidden include_editable_data_model remove_inactive]
{id ms/PositiveInt
include_hidden [:maybe ms/BooleanString]
include_editable_data_model [:maybe ms/BooleanString]
remove_inactive [:maybe ms/BooleanString]}
(db-metadata id
(Boolean/parseBoolean include_hidden)
(Boolean/parseBoolean include_editable_data_model)
(Boolean/parseBoolean remove_inactive))) |
--------------------------------- GET /api/database/:id/autocomplete_suggestions --------------------------------- | |
(defn- autocomplete-tables [db-id search-string limit]
(t2/select [Table :id :db_id :schema :name]
{:where [:and [:= :db_id db-id]
[:= :active true]
[:like :%lower.name (u/lower-case-en search-string)]
[:= :visibility_type nil]]
:order-by [[:%lower.name :asc]]
:limit limit})) | |
Returns cards that match the search string in the given database, ordered by id.
If the search string contains a number like '123' we match that as a prefix against the card IDs. If the search string contains a number at the start AND text like '123-foo' we match do an exact match on card ID, and a substring match on the card name. If the search string does not start with a number, and is text like 'foo' we match that as a substring on the card name. | (defn- autocomplete-cards
[database-id search-card-slug]
(let [search-id (re-find #"\d*" search-card-slug)
search-name (-> (re-matches #"\d*-?(.*)" search-card-slug)
second
(str/replace #"-" " ")
u/lower-case-en)]
(t2/select [Card :id :dataset :database_id :name :collection_id [:collection.name :collection_name]]
{:where [:and
[:= :report_card.database_id database-id]
[:= :report_card.archived false]
(cond
;; e.g. search-string = "123"
(and (not-empty search-id) (empty? search-name))
[:like
(h2x/cast (if (= (mdb.connection/db-type) :mysql) :char :text) :report_card.id)
(str search-id "%")]
;; e.g. search-string = "123-foo"
(and (not-empty search-id) (not-empty search-name))
[:and
[:= :report_card.id (Integer/parseInt search-id)]
;; this is a prefix match to be consistent with substring matches on the entire slug
[:like [:lower :report_card.name] (str search-name "%")]]
;; e.g. search-string = "foo"
(and (empty? search-id) (not-empty search-name))
[:like [:lower :report_card.name] (str "%" search-name "%")])]
:left-join [[:collection :collection] [:= :collection.id :report_card.collection_id]]
:order-by [[:dataset :desc] ; prioritize models
[:report_card.id :desc]] ; then most recently created
:limit 50}))) |
(defn- autocomplete-fields [db-id search-string limit]
(t2/select [Field :name :base_type :semantic_type :id :table_id [:table.name :table_name]]
:metabase_field.active true
:%lower.metabase_field/name [:like (u/lower-case-en search-string)]
:metabase_field.visibility_type [:not-in ["sensitive" "retired"]]
:table.db_id db-id
{:order-by [[[:lower :metabase_field.name] :asc]
[[:lower :table.name] :asc]]
:left-join [[:metabase_table :table] [:= :table.id :metabase_field.table_id]]
:limit limit})) | |
(defn- autocomplete-results [tables fields limit]
(let [tbl-count (count tables)
fld-count (count fields)
take-tables (min tbl-count (- limit (/ fld-count 2)))
take-fields (- limit take-tables)]
(concat (for [{table-name :name} (take take-tables tables)]
[table-name "Table"])
(for [{:keys [table_name base_type semantic_type name]} (take take-fields fields)]
[name (str table_name
" "
base_type
(when semantic_type
(str " " semantic_type)))])))) | |
match-string is a string that will be used with ilike. The it will be lowercased by autocomplete-{tables,fields}. | (defn- autocomplete-suggestions
[db-id match-string]
(let [limit 50
tables (filter mi/can-read? (autocomplete-tables db-id match-string limit))
fields (readable-fields-only (autocomplete-fields db-id match-string limit))]
(autocomplete-results tables fields limit))) |
Valid options for the autocomplete types. Can match on a substring ("%input%"), on a prefix ("input%"), or reject autocompletions. Large instances with lots of fields might want to use prefix matching or turn off the feature if it causes too many problems. | (def ^:private autocomplete-matching-options
#{:substring :prefix :off}) |
(defsetting native-query-autocomplete-match-style
(deferred-tru
(str "Matching style for native query editor's autocomplete. Can be \"substring\", \"prefix\", or \"off\". "
"Larger instances can have performance issues matching using substring, so can use prefix matching, "
" or turn autocompletions off."))
:visibility :public
:export? true
:type :keyword
:default :substring
:audit :raw-value
:setter (fn [v]
(let [v (cond-> v (string? v) keyword)]
(if (autocomplete-matching-options v)
(setting/set-value-of-type! :keyword :native-query-autocomplete-match-style v)
(throw (ex-info (tru "Invalid `native-query-autocomplete-match-style` option")
{:option v
:valid-options autocomplete-matching-options})))))) | |
/:id/autocomplete_suggestions | (api/defendpoint GET
"Return a list of autocomplete suggestions for a given `prefix`, or `substring`. Should only specify one, but
`substring` will have priority if both are present.
This is intended for use with the ACE Editor when the User is typing raw SQL. Suggestions include matching `Tables`
and `Fields` in this `Database`.
Tables are returned in the format `[table_name \"Table\"]`;
When Fields have a semantic_type, they are returned in the format `[field_name \"table_name base_type semantic_type\"]`
When Fields lack a semantic_type, they are returned in the format `[field_name \"table_name base_type\"]`"
[id prefix substring]
{id ms/PositiveInt
prefix [:maybe ms/NonBlankString]
substring [:maybe ms/NonBlankString]}
(api/read-check Database id)
(when (and (str/blank? prefix) (str/blank? substring))
(throw (ex-info (tru "Must include prefix or search") {:status-code 400})))
(try
(cond
substring
(autocomplete-suggestions id (str "%" substring "%"))
prefix
(autocomplete-suggestions id (str prefix "%")))
(catch Throwable e
(log/warn e (trs "Error with autocomplete: {0}" (ex-message e)))))) |
/:id/cardautocompletesuggestions | (api/defendpoint GET
"Return a list of `Card` autocomplete suggestions for a given `query` in a given `Database`.
This is intended for use with the ACE Editor when the User is typing in a template tag for a `Card`, e.g. {{#...}}."
[id query]
{id ms/PositiveInt
query ms/NonBlankString}
(api/read-check Database id)
(try
(->> (autocomplete-cards id query)
(filter mi/can-read?)
(map #(select-keys % [:id :name :dataset :collection_name])))
(catch Throwable e
(log/warn e (trs "Error with autocomplete: {0}" (ex-message e)))))) |
------------------------------------------ GET /api/database/:id/fields ------------------------------------------ | |
/:id/fields | (api/defendpoint GET
"Get a list of all `Fields` in `Database`."
[id]
{id ms/PositiveInt}
(api/read-check Database id)
(let [fields (filter mi/can-read? (-> (t2/select [Field :id :name :display_name :table_id :base_type :semantic_type]
:table_id [:in (t2/select-fn-set :id Table, :db_id id)]
:visibility_type [:not-in ["sensitive" "retired"]])
(t2/hydrate :table)))]
(for [{:keys [id name display_name table base_type semantic_type]} fields]
{:id id
:name name
:display_name display_name
:base_type base_type
:semantic_type semantic_type
:table_name (:name table)
:schema (:schema table)}))) |
----------------------------------------- GET /api/database/:id/idfields ----------------------------------------- | |
/:id/idfields | (api/defendpoint GET
"Get a list of all primary key `Fields` for `Database`."
[id include_editable_data_model]
{id ms/PositiveInt}
(let [[db-perm-check field-perm-check] (if (Boolean/parseBoolean include_editable_data_model)
[check-db-data-model-perms mi/can-write?]
[api/read-check mi/can-read?])]
(db-perm-check (t2/select-one Database :id id))
(sort-by (comp u/lower-case-en :name :table)
(filter field-perm-check (-> (database/pk-fields {:id id})
(t2/hydrate :table)))))) |
----------------------------------------------- POST /api/database ----------------------------------------------- | |
Try out the connection details for a database and useful error message if connection fails, returns | (defn test-database-connection
[engine {:keys [host port] :as details}, & {:keys [log-exception]
:or {log-exception true}}]
{:pre [(some? engine)]}
(let [engine (keyword engine)
details (assoc details :engine engine)]
(try
(cond
(driver.u/can-connect-with-details? engine details :throw-exceptions)
nil
(and host port (u/host-port-up? host port))
{:message (tru "Connection to ''{0}:{1}'' successful, but could not connect to DB."
host port)}
(and host (u/host-up? host))
{:message (tru "Connection to host ''{0}'' successful, but port {1} is invalid."
host port)
:errors {:port (deferred-tru "check your port settings")}}
host
{:message (tru "Host ''{0}'' is not reachable" host)
:errors {:host (deferred-tru "check your host settings")}}
:else
{:message (tru "Unable to connect to database.")})
(catch Throwable e
(when (and log-exception (not (some->> e ex-cause ex-data ::driver/can-connect-message?)))
(log/error e (trs "Cannot connect to Database")))
(if (-> e ex-data :message)
(ex-data e)
{:message (.getMessage e)}))))) |
Does the given TODO - Just make | (defn- supports-ssl?
[driver]
{:pre [(driver/available? driver)]}
(let [driver-props (set (for [field (driver/connection-properties driver)]
(:name field)))]
(contains? driver-props "ssl"))) |
(mu/defn ^:private test-connection-details :- :map
"Try a making a connection to database `engine` with `details`.
If the `details` has SSL explicitly enabled, go with that and do not accept plaintext connections. If it is disabled,
try twice: once with SSL, and a second time without if the first fails. If either attempt is successful, returns
the details used to successfully connect. Otherwise returns a map with the connection error message. (This map will
also contain the key `:valid` = `false`, which you can use to distinguish an error from valid details.)"
[engine :- DBEngineString
details :- :map]
(let [;; Try SSL first if SSL is supported and not already enabled
;; If not successful or not applicable, details-with-ssl will be nil
details-with-ssl (assoc details :ssl true)
details-with-ssl (when (and (supports-ssl? (keyword engine))
(not (true? (:ssl details)))
(nil? (test-database-connection engine details-with-ssl :log-exception false)))
details-with-ssl)]
(or
;; Opportunistic SSL
details-with-ssl
;; Try with original parameters
(some-> (test-database-connection engine details)
(assoc :valid false))
details))) | |
/ | (api/defendpoint POST
"Add a new `Database`."
[:as {{:keys [name engine details is_full_sync is_on_demand schedules auto_run_queries cache_ttl]} :body}]
{name ms/NonBlankString
engine DBEngineString
details ms/Map
is_full_sync [:maybe :boolean]
is_on_demand [:maybe :boolean]
schedules [:maybe sync.schedules/ExpandedSchedulesMap]
auto_run_queries [:maybe :boolean]
cache_ttl [:maybe ms/PositiveInt]}
(api/check-superuser)
(when cache_ttl
(api/check (premium-features/enable-cache-granular-controls?)
[402 (tru (str "The cache TTL database setting is only enabled if you have a premium token with the "
"cache granular controls feature."))]))
(let [is-full-sync? (or (nil? is_full_sync)
(boolean is_full_sync))
details-or-error (test-connection-details engine details)
valid? (not= (:valid details-or-error) false)]
(if valid?
;; no error, proceed with creation. If record is inserted successfuly, publish a `:database-create` event.
;; Throw a 500 if nothing is inserted
(u/prog1 (api/check-500 (first (t2/insert-returning-instances!
Database
(merge
{:name name
:engine engine
:details details-or-error
:is_full_sync is-full-sync?
:is_on_demand (boolean is_on_demand)
:cache_ttl cache_ttl
:creator_id api/*current-user-id*}
(sync.schedules/schedule-map->cron-strings
(if (:let-user-control-scheduling details)
(sync.schedules/scheduling schedules)
(sync.schedules/default-randomized-schedule)))
(when (some? auto_run_queries)
{:auto_run_queries auto_run_queries})))))
(events/publish-event! :event/database-create {:object <> :user-id api/*current-user-id*})
(snowplow/track-event! ::snowplow/database-connection-successful
api/*current-user-id*
{:database engine
:database-id (u/the-id <>)
:source :admin
:dbms-version (:version (driver/dbms-version (keyword engine) <>))}))
;; failed to connect, return error
(do
(snowplow/track-event! ::snowplow/database-connection-failed
api/*current-user-id*
{:database engine :source :setup})
{:status 400
:body (dissoc details-or-error :valid)})))) |
/validate | (api/defendpoint POST
"Validate that we can connect to a database given a set of details."
;; TODO - why do we pass the DB in under the key `details`?
[:as {{{:keys [engine details]} :details} :body}]
{engine DBEngineString
details :map}
(api/check-superuser)
(let [details-or-error (test-connection-details engine details)]
{:valid (not (false? (:valid details-or-error)))})) |
--------------------------------------- POST /api/database/sample_database ---------------------------------------- | |
/sample_database | (api/defendpoint POST "Add the sample database as a new `Database`." [] (api/check-superuser) (sample-data/add-sample-database!) (t2/select-one Database :is_sample true)) |
--------------------------------------------- PUT /api/database/:id ---------------------------------------------- | |
Replace any sensitive values not overriden in the PUT with the original values | (defn- upsert-sensitive-fields
[database details]
(when details
(merge (:details database)
(reduce
(fn [details k]
(if (= protected-password (get details k))
(m/update-existing details k (constantly (get-in database [:details k])))
details))
details
(database/sensitive-fields-for-db database))))) |
/:id/persist | (api/defendpoint POST
"Attempt to enable model persistence for a database. If already enabled returns a generic 204."
[id]
{id ms/PositiveInt}
(api/check (public-settings/persisted-models-enabled)
400
(tru "Persisting models is not enabled."))
(api/let-404 [database (t2/select-one Database :id id)]
(api/write-check database)
(if (-> database :settings :persist-models-enabled)
;; todo: some other response if already persisted?
api/generic-204-no-content
(let [[success? error] (ddl.i/check-can-persist database)
schema (ddl.i/schema-name database (public-settings/site-uuid))]
(if success?
;; do secrets require special handling to not clobber them or mess up encryption?
(do (t2/update! Database id {:settings (assoc (:settings database) :persist-models-enabled true)})
(task.persist-refresh/schedule-persistence-for-database!
database
(public-settings/persisted-model-refresh-cron-schedule))
api/generic-204-no-content)
(throw (ex-info (ddl.i/error->message error schema)
{:error error
:database (:name database)}))))))) |
/:id/unpersist | (api/defendpoint POST
"Attempt to disable model persistence for a database. If already not enabled, just returns a generic 204."
[id]
{id ms/PositiveInt}
(api/let-404 [database (t2/select-one Database :id id)]
(api/write-check database)
(if (-> database :settings :persist-models-enabled)
(do (t2/update! Database id {:settings (dissoc (:settings database) :persist-models-enabled)})
(persisted-info/mark-for-pruning! {:database_id id})
(task.persist-refresh/unschedule-persistence-for-database! database)
api/generic-204-no-content)
;; todo: a response saying this was a no-op? an error? same on the post to persist
api/generic-204-no-content))) |
/:id | (api/defendpoint PUT
"Update a `Database`."
[id :as {{:keys [name engine details is_full_sync is_on_demand description caveats points_of_interest schedules
auto_run_queries refingerprint cache_ttl settings]} :body}]
{id ms/PositiveInt
name [:maybe ms/NonBlankString]
engine [:maybe DBEngineString]
refingerprint [:maybe :boolean]
details [:maybe ms/Map]
schedules [:maybe sync.schedules/ExpandedSchedulesMap]
description [:maybe :string] ; :string instead of ms/NonBlankString because we don't care
caveats [:maybe :string] ; whether someone sets these to blank strings
points_of_interest [:maybe :string]
auto_run_queries [:maybe :boolean]
cache_ttl [:maybe ms/PositiveInt]
settings [:maybe ms/Map]}
;; TODO - ensure that custom schedules and let-user-control-scheduling go in lockstep
(let [existing-database (api/write-check (t2/select-one Database :id id))
details (some->> details
(driver.u/db-details-client->server (or engine (:engine existing-database)))
(upsert-sensitive-fields existing-database))
;; verify that we can connect to the database if `:details` OR `:engine` have changed.
details-changed? (some-> details (not= (:details existing-database)))
engine-changed? (some-> engine keyword (not= (:engine existing-database)))
conn-error (when (or details-changed? engine-changed?)
(test-database-connection (or engine (:engine existing-database))
(or details (:details existing-database))))
full-sync? (some-> is_full_sync boolean)]
(if conn-error
;; failed to connect, return error
{:status 400
:body conn-error}
;; no error, proceed with update
(do
;; TODO - is there really a reason to let someone change the engine on an existing database?
;; that seems like the kind of thing that will almost never work in any practical way
;; TODO - this means one cannot unset the description. Does that matter?
(t2/update! Database id
(m/remove-vals
nil?
(merge
{:name name
:engine engine
:details details
:refingerprint refingerprint
:is_full_sync full-sync?
:is_on_demand (boolean is_on_demand)
:description description
:caveats caveats
:points_of_interest points_of_interest
:auto_run_queries auto_run_queries}
;; upsert settings with a PATCH-style update. `nil` key means unset the Setting.
(when (seq settings)
{:settings (into {}
(remove (fn [[_k v]] (nil? v)))
(merge (:settings existing-database) settings))})
(cond
;; transition back to metabase managed schedules. the schedule
;; details, even if provided, are ignored. database is the
;; current stored value and check against the incoming details
(and (get-in existing-database [:details :let-user-control-scheduling])
(not (:let-user-control-scheduling details)))
(sync.schedules/schedule-map->cron-strings (sync.schedules/default-randomized-schedule))
;; if user is controlling schedules
(:let-user-control-scheduling details)
(sync.schedules/schedule-map->cron-strings (sync.schedules/scheduling schedules))))))
;; do nothing in the case that user is not in control of
;; scheduling. leave them as they are in the db
;; unlike the other fields, folks might want to nil out cache_ttl. it should also only be settable on EE
;; with the advanced-config feature enabled.
(when (premium-features/enable-cache-granular-controls?)
(t2/update! Database id {:cache_ttl cache_ttl}))
(let [db (t2/select-one Database :id id)]
(events/publish-event! :event/database-update {:object db
:user-id api/*current-user-id*
:previous-object existing-database})
;; return the DB with the expanded schedules back in place
(add-expanded-schedules db)))))) |
-------------------------------------------- DELETE /api/database/:id -------------------------------------------- | |
/:id | (api/defendpoint DELETE
"Delete a `Database`."
[id]
{id ms/PositiveInt}
(api/check-superuser)
(api/let-404 [db (t2/select-one Database :id id)]
(api/check-403 (mi/can-write? db))
(t2/delete! Database :id id)
(events/publish-event! :event/database-delete {:object db :user-id api/*current-user-id*}))
api/generic-204-no-content) |
------------------------------------------ POST /api/database/:id/sync_schema ------------------------------------------- | |
/:id/sync_schema Should somehow trigger sync-database/sync-database! | (api/defendpoint POST
"Trigger a manual update of the schema metadata for this `Database`."
[id]
{id ms/PositiveInt}
;; just wrap this in a future so it happens async
(let [db (api/write-check (t2/select-one Database :id id))]
(events/publish-event! :event/database-manual-sync {:object db :user-id api/*current-user-id*})
(if-let [ex (try
;; it's okay to allow testing H2 connections during sync. We only want to disallow you from testing them for the
;; purposes of creating a new H2 database.
(binding [h2/*allow-testing-h2-connections* true]
(driver.u/can-connect-with-details? (:engine db) (:details db) :throw-exceptions))
nil
(catch Throwable e
e))]
(throw (ex-info (ex-message ex) {:status-code 422}))
(do
(future
(sync-metadata/sync-db-metadata! db)
(analyze/analyze-db! db))
{:status :ok})))) |
/:id/dismiss_spinner | (api/defendpoint POST
"Manually set the initial sync status of the `Database` and corresponding
tables to be `complete` (see #20863)"
[id]
{id ms/PositiveInt}
;; manual full sync needs to be async, but this is a simple update of `Database`
(let [db (api/write-check (t2/select-one Database :id id))
tables (map api/write-check (:tables (first (add-tables [db]))))]
(sync-util/set-initial-database-sync-complete! db)
;; avoid n+1
(when-let [table-ids (seq (map :id tables))]
(t2/update! Table {:id [:in table-ids]} {:initial_sync_status "complete"})))
{:status :ok}) |
------------------------------------------ POST /api/database/:id/rescan_values ------------------------------------------- | |
TODO - do we also want an endpoint to manually trigger analysis. Or separate ones for classification/fingerprinting? | |
Boolean indicating whether the rescan_values job should be done async or not. Defaults to | (def ^:dynamic *rescan-values-async* true) |
/:id/rescan_values Should somehow trigger cached-values/cache-field-values-for-database! | (api/defendpoint POST
"Trigger a manual scan of the field values for this `Database`."
[id]
{id ms/PositiveInt}
;; just wrap this is a future so it happens async
(let [db (api/write-check (t2/select-one Database :id id))]
(events/publish-event! :event/database-manual-scan {:object db :user-id api/*current-user-id*})
;; Override *current-user-permissions-set* so that permission checks pass during sync. If a user has DB detail perms
;; but no data perms, they should stll be able to trigger a sync of field values. This is fine because we don't
;; return any actual field values from this API. (#21764)
(binding [api/*current-user-permissions-set* (atom #{"/"})]
(if *rescan-values-async*
(future (field-values/update-field-values! db))
(field-values/update-field-values! db))))
{:status :ok}) |
"Discard saved field values" action in db UI | (defn- database->field-values-ids [database-or-id]
(map :id (mdb.query/query {:select [[:fv.id :id]]
:from [[:metabase_fieldvalues :fv]]
:left-join [[:metabase_field :f] [:= :fv.field_id :f.id]
[:metabase_table :t] [:= :f.table_id :t.id]]
:where [:= :t.db_id (u/the-id database-or-id)]}))) |
(defn- delete-all-field-values-for-database! [database-or-id]
(when-let [field-values-ids (seq (database->field-values-ids database-or-id))]
(t2/query-one {:delete-from :metabase_fieldvalues
:where [:in :id field-values-ids]}))) | |
/:id/discard_values TODO - should this be something like DELETE /api/database/:id/field_values instead? | (api/defendpoint POST
"Discards all saved field values for this `Database`."
[id]
{id ms/PositiveInt}
(let [db (api/write-check (t2/select-one Database :id id))]
(events/publish-event! :event/database-discard-field-values {:object db :user-id api/*current-user-id*})
(delete-all-field-values-for-database! db))
{:status :ok}) |
------------------------------------------ GET /api/database/:id/schemas ----------------------------------------- | |
Does the current user have permissions to know the schema with | (defn- can-read-schema?
[database-id schema-name]
(or
(perms/set-has-partial-permissions? @api/*current-user-permissions-set*
(perms/data-perms-path database-id schema-name))
(perms/set-has-full-permissions? @api/*current-user-permissions-set*
(perms/data-model-write-perms-path database-id schema-name)))) |
/:id/syncable_schemas | (api/defendpoint GET
"Returns a list of all syncable schemas found for the database `id`."
[id]
{id ms/PositiveInt}
(let [db (api/check-404 (t2/select-one Database id))]
(api/check-403 (mi/can-write? db))
(->> db
(driver/syncable-schemas (:engine db))
(vec)
(sort)))) |
/:id/schemas | (api/defendpoint GET
"Returns a list of all the schemas with tables found for the database `id`. Excludes schemas with no tables."
[id include_editable_data_model include_hidden]
{id ms/PositiveInt
include_editable_data_model [:maybe ms/BooleanValue]
include_hidden [:maybe ms/BooleanValue]}
(let [filter-schemas (fn [schemas]
(if include_editable_data_model
(if-let [f (u/ignore-exceptions
(classloader/require 'metabase-enterprise.advanced-permissions.common)
(resolve 'metabase-enterprise.advanced-permissions.common/filter-schema-by-data-model-perms))]
(map :schema (f (map (fn [s] {:db_id id :schema s}) schemas)))
schemas)
(filter (partial can-read-schema? id) schemas)))]
(if include_editable_data_model
(api/check-404 (t2/select-one Database id))
(api/read-check Database id))
(->> (t2/select-fn-set :schema Table
:db_id id :active true
(merge
{:order-by [[:%lower.schema :asc]]}
(when-not include_hidden
;; a non-nil value means Table is hidden -- see [[metabase.models.table/visibility-types]]
{:where [:= :visibility_type nil]})))
filter-schemas
;; for `nil` schemas return the empty string
(map #(if (nil? %) "" %))
distinct
sort))) |
(api/defendpoint GET ["/:virtual-db/schemas"
:virtual-db (re-pattern (str lib.schema.id/saved-questions-virtual-database-id))]
"Returns a list of all the schemas found for the saved questions virtual database."
[]
(when (public-settings/enable-nested-queries)
(->> (cards-virtual-tables :card)
(map :schema)
distinct
(sort-by u/lower-case-en)))) | |
(api/defendpoint GET ["/:virtual-db/datasets"
:virtual-db (re-pattern (str lib.schema.id/saved-questions-virtual-database-id))]
"Returns a list of all the datasets found for the saved questions virtual database."
[]
(when (public-settings/enable-nested-queries)
(->> (cards-virtual-tables :dataset)
(map :schema)
distinct
(sort-by u/lower-case-en)))) | |
------------------------------------- GET /api/database/:id/schema/:schema --------------------------------------- | |
(defn- schema-tables-list
([db-id schema]
(schema-tables-list db-id schema nil nil))
([db-id schema include_hidden include_editable_data_model]
(when-not include_editable_data_model
(api/read-check Database db-id)
(api/check-403 (can-read-schema? db-id schema)))
(let [tables (if include_hidden
(t2/select Table
:db_id db-id
:schema schema
:active true
{:order-by [[:display_name :asc]]})
(t2/select Table
:db_id db-id
:schema schema
:active true
:visibility_type nil
{:order-by [[:display_name :asc]]}))]
(if include_editable_data_model
(if-let [f (when config/ee-available?
(classloader/require 'metabase-enterprise.advanced-permissions.common)
(resolve 'metabase-enterprise.advanced-permissions.common/filter-tables-by-data-model-perms))]
(f tables)
tables)
(filter mi/can-read? tables))))) | |
/:id/schema/:schema | (api/defendpoint GET
"Returns a list of Tables for the given Database `id` and `schema`"
[id include_hidden include_editable_data_model schema]
{id ms/PositiveInt
include_hidden [:maybe ms/BooleanValue]
include_editable_data_model [:maybe ms/BooleanValue]}
(api/check-404 (seq (schema-tables-list
id
schema
include_hidden
include_editable_data_model)))) |
/:id/schema/ | (api/defendpoint GET
"Return a list of Tables for a Database whose `schema` is `nil` or an empty string."
[id include_hidden include_editable_data_model]
{id ms/PositiveInt
include_hidden [:maybe ms/BooleanValue]
include_editable_data_model [:maybe ms/BooleanValue]}
(api/check-404 (seq (concat (schema-tables-list id nil include_hidden include_editable_data_model)
(schema-tables-list id "" include_hidden include_editable_data_model))))) |
(api/defendpoint GET ["/:virtual-db/schema/:schema"
:virtual-db (re-pattern (str lib.schema.id/saved-questions-virtual-database-id))]
"Returns a list of Tables for the saved questions virtual database."
[schema]
(when (public-settings/enable-nested-queries)
(->> (source-query-cards
:card
:additional-constraints [(if (= schema (api.table/root-collection-schema-name))
[:= :collection_id nil]
[:in :collection_id (api/check-404 (not-empty (t2/select-pks-set Collection :name schema)))])])
(map api.table/card->virtual-table)))) | |
(api/defendpoint GET ["/:virtual-db/datasets/:schema"
:virtual-db (re-pattern (str lib.schema.id/saved-questions-virtual-database-id))]
"Returns a list of Tables for the datasets virtual database."
[schema]
(when (public-settings/enable-nested-queries)
(->> (source-query-cards
:dataset
:additional-constraints [(if (= schema (api.table/root-collection-schema-name))
[:= :collection_id nil]
[:in :collection_id (api/check-404 (not-empty (t2/select-pks-set Collection :name schema)))])])
(map api.table/card->virtual-table)))) | |
(api/define-routes) | |
/api/dataset endpoints. | (ns metabase.api.dataset (:require [cheshire.core :as json] [clojure.string :as str] [compojure.core :refer [POST]] [metabase.api.common :as api] [metabase.api.field :as api.field] [metabase.driver :as driver] [metabase.driver.util :as driver.u] [metabase.events :as events] [metabase.lib.schema.id :as lib.schema.id] [metabase.mbql.normalize :as mbql.normalize] [metabase.mbql.schema :as mbql.s] [metabase.models.card :refer [Card]] [metabase.models.database :as database :refer [Database]] [metabase.models.params.custom-values :as custom-values] [metabase.models.persisted-info :as persisted-info] [metabase.models.query :as query] [metabase.models.table :refer [Table]] [metabase.query-processor :as qp] [metabase.query-processor.middleware.constraints :as qp.constraints] [metabase.query-processor.middleware.permissions :as qp.perms] [metabase.query-processor.pivot :as qp.pivot] [metabase.query-processor.streaming :as qp.streaming] [metabase.query-processor.util :as qp.util] [metabase.shared.models.visualization-settings :as mb.viz] [metabase.util :as u] [metabase.util.i18n :refer [trs tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [steffan-westcott.clj-otel.api.trace.span :as span] [toucan2.core :as t2])) |
-------------------------------------------- Running a Query Normally -------------------------------------------- | |
Return the ID of the Card used as the "source" query of this query, if applicable; otherwise return | (defn- query->source-card-id
[outer-query]
(when-let [source-card-id (qp.util/query->source-card-id outer-query)]
(log/info (trs "Source query for this query is Card {0}" (pr-str source-card-id)))
(api/read-check Card source-card-id)
source-card-id)) |
(defn- run-query-async
[{:keys [database], :as query}
& {:keys [context export-format qp-runner]
:or {context :ad-hoc
export-format :api
qp-runner qp/process-query-and-save-with-max-results-constraints!}}]
(span/with-span!
{:name "run-query-async"}
(when (and (not= (:type query) "internal")
(not= database lib.schema.id/saved-questions-virtual-database-id))
(when-not database
(throw (ex-info (tru "`database` is required for all queries whose type is not `internal`.")
{:status-code 400, :query query})))
(api/read-check Database database))
;; store table id trivially iff we get a query with simple source-table
(let [table-id (get-in query [:query :source-table])]
(when (int? table-id)
(events/publish-event! :event/table-read {:object (t2/select-one Table :id table-id)
:user-id api/*current-user-id*})))
;; add sensible constraints for results limits on our query
(let [source-card-id (query->source-card-id query)
source-card (when source-card-id
(t2/select-one [Card :result_metadata :dataset] :id source-card-id))
info (cond-> {:executed-by api/*current-user-id*
:context context
:card-id source-card-id}
(:dataset source-card)
(assoc :metadata/dataset-metadata (:result_metadata source-card)))]
(binding [qp.perms/*card-id* source-card-id]
(qp.streaming/streaming-response [{:keys [rff context]} export-format]
(qp-runner query info rff context)))))) | |
/ | (api/defendpoint POST
"Execute a query and retrieve the results in the usual format. The query will not use the cache."
[:as {{:keys [database] :as query} :body}]
{database [:maybe :int]}
(run-query-async (update-in query [:middleware :js-int-to-string?] (fnil identity true)))) |
----------------------------------- Downloading Query Results in Other Formats ----------------------------------- | |
Valid export formats for downloading query results. | (def export-formats (mapv u/qualified-name (qp.streaming/export-formats))) |
Schema for valid export formats for downloading query results. | (def ExportFormat (into [:enum] export-formats)) |
(mu/defn export-format->context :- mbql.s/Context
"Return the `:context` that should be used when saving a QueryExecution triggered by a request to download results
in `export-format`.
(export-format->context :json) ;-> :json-download"
[export-format]
(keyword (str (u/qualified-name export-format) "-download"))) | |
Regex for matching valid export formats (e.g., (api/defendpoint-schema POST ["/:export-format", :export-format export-format-regex] | (def export-format-regex
(re-pattern (str "(" (str/join "|" (map u/qualified-name (qp.streaming/export-formats))) ")"))) |
(def ^:private column-ref-regex #"^\[.+\]$") | |
Key function for parsing JSON visualization settings into the DB form. Converts most keys to keywords, but leaves column references as strings. | (defn- viz-setting-key-fn
[json-key]
(if (re-matches column-ref-regex json-key)
json-key
(keyword json-key))) |
(api/defendpoint POST ["/:export-format", :export-format export-format-regex]
"Execute a query and download the result data as a file in the specified format."
[export-format :as {{:keys [query visualization_settings] :or {visualization_settings "{}"}} :params}]
{query ms/JSONString
visualization_settings ms/JSONString
export-format (into [:enum] export-formats)}
(let [query (json/parse-string query keyword)
viz-settings (-> (json/parse-string visualization_settings viz-setting-key-fn)
(update :table.columns mbql.normalize/normalize)
mb.viz/db->norm)
query (-> (assoc query
:async? true
:viz-settings viz-settings)
(dissoc :constraints)
(update :middleware #(-> %
(dissoc :add-default-userland-constraints? :js-int-to-string?)
(assoc :process-viz-settings? true
:skip-results-metadata? true
:format-rows? false))))]
(run-query-async
query
:export-format export-format
:context (export-format->context export-format)
:qp-runner qp/process-query-and-save-execution!))) | |
------------------------------------------------ Other Endpoints ------------------------------------------------- | |
/duration TODO - this is no longer used. Should we remove it? | (api/defendpoint POST
"Get historical query execution duration."
[:as {{:keys [database], :as query} :body}]
(api/read-check Database database)
;; try calculating the average for the query as it was given to us, otherwise with the default constraints if
;; there's no data there. If we still can't find relevant info, just default to 0
{:average (or
(some (comp query/average-execution-time-ms qp.util/query-hash)
[query
(assoc query :constraints (qp.constraints/default-query-constraints))])
0)}) |
/native | (api/defendpoint POST
"Fetch a native version of an MBQL query."
[:as {{:keys [database pretty] :as query} :body}]
{database ms/PositiveInt
pretty [:maybe :boolean]}
(binding [persisted-info/*allow-persisted-substitution* false]
(qp.perms/check-current-user-has-adhoc-native-query-perms query)
(let [driver (driver.u/database->driver database)
prettify (partial driver/prettify-native-form driver)
compiled (qp/compile-and-splice-parameters query)]
(cond-> compiled
(not (false? pretty)) (update :query prettify))))) |
/pivot | (api/defendpoint POST
"Generate a pivoted dataset for an ad-hoc query"
[:as {{:keys [database] :as query} :body}]
{database [:maybe ms/PositiveInt]}
(when-not database
(throw (Exception. (str (tru "`database` is required for all queries.")))))
(api/read-check Database database)
(let [info {:executed-by api/*current-user-id*
:context :ad-hoc}]
(qp.streaming/streaming-response [{:keys [rff context]} :api]
(qp.pivot/run-pivot-query (assoc query
:async? true
:constraints (qp.constraints/default-query-constraints))
info
rff
context)))) |
(defn- parameter-field-values
[field-ids query]
(when-not (seq field-ids)
(throw (ex-info (tru "Missing field-ids for parameter")
{:status-code 400})))
(-> (reduce (fn [resp id]
(let [{values :values more? :has_more_values} (api.field/search-values-from-field-id id query)]
(-> resp
(update :values concat values)
(update :has_more_values #(or % more?)))))
{:has_more_values false
:values []}
field-ids)
;; deduplicate the values returned from multiple fields
(update :values (comp vec set)))) | |
Fetch parameter values. Parameter should be a full parameter, field-ids is an optional vector of field ids, only
consulted if | (defn parameter-values
[parameter field-ids query]
(custom-values/parameter->values
parameter query
(fn [] (parameter-field-values field-ids query)))) |
/parameter/values | (api/defendpoint POST
"Return parameter values for cards or dashboards that are being edited."
[:as {{:keys [parameter field_ids]} :body}]
{parameter ms/Parameter
field_ids [:maybe [:sequential ms/PositiveInt]]}
(parameter-values parameter field_ids nil)) |
/parameter/search/:query | (api/defendpoint POST
"Return parameter values for cards or dashboards that are being edited. Expects a query string at `?query=foo`."
[query :as {{:keys [parameter field_ids]} :body}]
{parameter ms/Parameter
field_ids [:maybe [:sequential ms/PositiveInt]]
query ms/NonBlankString}
(parameter-values parameter field_ids query)) |
(api/define-routes) | |
/api/email endpoints | (ns metabase.api.email (:require [clojure.data :as data] [clojure.set :as set] [clojure.string :as str] [compojure.core :refer [DELETE POST PUT]] [metabase.api.common :as api] [metabase.api.common.validation :as validation] [metabase.email :as email] [metabase.models.setting :as setting] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log])) |
(set! *warn-on-reflection* true) | |
(def ^:private mb-to-smtp-settings
{:email-smtp-host :host
:email-smtp-username :user
:email-smtp-password :pass
:email-smtp-port :port
:email-smtp-security :security
:email-from-name :sender-name
:email-from-address :sender
:email-reply-to :reply-to}) | |
Convert raw error message responses from our email functions into our normal api error response structure. | (defn- humanize-error-messages
[{::email/keys [error]}]
(when error
(let [conn-error {:errors {:email-smtp-host "Wrong host or port"
:email-smtp-port "Wrong host or port"}}
creds-error {:errors {:email-smtp-username "Wrong username or password"
:email-smtp-password "Wrong username or password"}}
exceptions (u/full-exception-chain error)
message (str/join ": " (map ex-message exceptions))
match-error (fn match-error [regex-or-exception-class [message exceptions]]
(cond (instance? java.util.regex.Pattern regex-or-exception-class)
(re-find regex-or-exception-class message)
(class? regex-or-exception-class)
(some (partial instance? regex-or-exception-class) exceptions)))]
(log/warn "Problem connecting to mail server:" message)
(condp match-error [message exceptions]
;; bad host = "Unknown SMTP host: foobar"
#"^Unknown SMTP host:.*$"
conn-error
;; host seems valid, but host/port failed connection = "Could not connect to SMTP host: localhost, port: 123"
#".*Could(?: not)|(?:n't) connect to (?:SMTP )?host.*"
conn-error
;; seen this show up on mandrill
#"^Invalid Addresses$"
creds-error
;; seen this show up on mandrill using TLS with bad credentials
#"^failed to connect, no password specified\?$"
creds-error
;; madrill authentication failure
#"^435 4.7.8 Error: authentication failed:.*$"
creds-error
javax.mail.AuthenticationFailedException
creds-error
;; everything else :(
{:message (str "Sorry, something went wrong. Please try again. Error: " message)})))) |
Formats warnings when security settings are autocorrected. | (defn- humanize-email-corrections
[corrections]
(into
{}
(for [[k v] corrections]
[k (tru "{0} was autocorrected to {1}"
(name (mb-to-smtp-settings k))
(u/upper-case-en v))]))) |
Returns a map of setting names (keywords) and env var values. If an env var is not set, the setting is not included in the result. | (defn- env-var-values-by-email-setting
[]
(into {}
(for [setting-name (keys mb-to-smtp-settings)
:let [value (setting/env-var-value setting-name)]
:when (some? value)]
[setting-name value]))) |
/ | (api/defendpoint PUT
"Update multiple email Settings. You must be a superuser or have `setting` permission to do this."
[:as {settings :body}]
{settings :map}
(validation/check-has-application-permission :setting)
(let [;; the frontend has access to an obfuscated version of the password. Watch for whether it sent us a new password or
;; the obfuscated version
obfuscated? (and (:email-smtp-password settings) (email/email-smtp-password)
(= (:email-smtp-password settings) (setting/obfuscate-value (email/email-smtp-password))))
;; override `nil` values in the request with environment variables for testing the SMTP connection
env-var-settings (env-var-values-by-email-setting)
settings (merge settings env-var-settings)
settings (-> (cond-> settings
obfuscated?
(assoc :email-smtp-password (email/email-smtp-password)))
(select-keys (keys mb-to-smtp-settings))
(set/rename-keys mb-to-smtp-settings))
settings (cond-> settings
(string? (:port settings)) (update :port #(Long/parseLong ^String %))
(string? (:security settings)) (update :security keyword))
response (email/test-smtp-connection settings)]
(if-not (::email/error response)
;; test was good, save our settings
(let [[_ corrections] (data/diff settings response)
new-settings (set/rename-keys response (set/map-invert mb-to-smtp-settings))]
;; don't update settings if they are set by environment variables
(setting/set-many! (apply dissoc new-settings (keys env-var-settings)))
(cond-> (assoc new-settings :with-corrections (-> corrections
(set/rename-keys (set/map-invert mb-to-smtp-settings))
humanize-email-corrections))
obfuscated? (update :email-smtp-password setting/obfuscate-value)))
;; test failed, return response message
{:status 400
:body (humanize-error-messages response)}))) |
/ | (api/defendpoint DELETE "Clear all email related settings. You must be a superuser or have `setting` permission to do this." [] (validation/check-has-application-permission :setting) (setting/set-many! (zipmap (keys mb-to-smtp-settings) (repeat nil))) api/generic-204-no-content) |
/test | (api/defendpoint POST
"Send a test email using the SMTP Settings. You must be a superuser or have `setting` permission to do this.
Returns `{:ok true}` if we were able to send the message successfully, otherwise a standard 400 error response."
[]
(validation/check-has-application-permission :setting)
(when-not (and (email/email-smtp-port) (email/email-smtp-host))
{:status 400
:body "Wrong host or port"})
(let [response (email/send-message-or-throw!
{:subject "Metabase Test Email"
:recipients [(:email @api/*current-user*)]
:message-type :text
:message "Your Metabase emails are working — hooray!"})]
(if-not (::email/error response)
{:ok true}
{:status 400
:body (humanize-error-messages response)}))) |
(api/define-routes) | |
Various endpoints that use JSON web tokens to fetch Cards and Dashboards.
The endpoints are the same as the ones in To use these endpoints:
| (ns metabase.api.embed
(:require
[clojure.set :as set]
[clojure.string :as str]
[compojure.core :refer [GET]]
[medley.core :as m]
[metabase.api.card :as api.card]
[metabase.api.common :as api]
[metabase.api.common.validation :as validation]
[metabase.api.dashboard :as api.dashboard]
[metabase.api.dataset :as api.dataset]
[metabase.api.public :as api.public]
[metabase.driver.common.parameters.operators :as params.ops]
[metabase.events :as events]
[metabase.models.card :as card :refer [Card]]
[metabase.models.dashboard :refer [Dashboard]]
[metabase.models.params :as params]
[metabase.pulse.parameters :as pulse-params]
[metabase.query-processor :as qp]
[metabase.query-processor.middleware.constraints :as qp.constraints]
[metabase.query-processor.pivot :as qp.pivot]
[metabase.util :as u]
[metabase.util.embed :as embed]
[metabase.util.i18n
:as i18n
:refer [tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
------------------------------------------------- Param Checking ------------------------------------------------- | |
Check that the conditions specified by | (defn- check-params-are-allowed
[object-embedding-params token-params user-params]
(let [all-params (set/union token-params user-params)
duplicated-params (set/intersection token-params user-params)]
(doseq [[param status] object-embedding-params]
(case status
;; disabled means a param is not allowed to be specified by either token or user
"disabled" (api/check (not (contains? all-params param))
[400 (tru "You''re not allowed to specify a value for {0}." param)])
;; enabled means either JWT *or* user can specify the param, but not both. Param is *not* required
"enabled" (api/check (not (contains? duplicated-params param))
[400 (tru "You can''t specify a value for {0} if it''s already set in the JWT." param)])
;; locked means JWT must specify param
"locked" (api/check
(contains? token-params param) [400 (tru "You must specify a value for {0} in the JWT." param)]
(not (contains? user-params param)) [400 (tru "You can only specify a value for {0} in the JWT." param)]))))) |
Make sure all the params specified are specified in | (defn- check-params-exist
[object-embedding-params all-params]
(let [embedding-params (set (keys object-embedding-params))]
(doseq [k all-params]
(api/check (contains? embedding-params k)
[400 (format "Unknown parameter %s." k)])))) |
Validate that sets of params passed as part of the JWT token and by the user (as query params, i.e. as part of the
URL) are valid for the | (defn- check-param-sets
[object-embedding-params token-params user-params]
;; TODO - maybe make this log/debug once embedding is wrapped up
(log/debug "Validating params for embedded object:\n"
"object embedding params:" object-embedding-params
"token params:" token-params
"user params:" user-params)
(check-params-are-allowed object-embedding-params token-params user-params)
(check-params-exist object-embedding-params (set/union token-params user-params))) |
Is V a valid param value? (If it is a String, is it non-blank?) | (defn- valid-param?
[v]
(or (not (string? v))
(not (str/blank? v)))) |
(mu/defn ^:private validate-and-merge-params :- [:map-of :keyword :any]
"Validate that the `token-params` passed in the JWT and the `user-params` (passed as part of the URL) are allowed, and
that ones that are required are specified by checking them against a Card or Dashboard's `object-embedding-params`
(the object's value of `:embedding_params`). Throws a 400 if any of the checks fail. If all checks are successful,
returns a *merged* parameters map."
[object-embedding-params :- ms/EmbeddingParams
token-params :- [:map-of :keyword :any]
user-params :- [:map-of :keyword :any]]
(check-param-sets object-embedding-params
(set (keys (m/filter-vals valid-param? token-params)))
(set (keys (m/filter-vals valid-param? user-params))))
;; ok, everything checks out, now return the merged params map
(merge user-params token-params)) | |
---------------------------------------------- Other Param Util Fns ---------------------------------------------- | |
Remove any | (defn- remove-params-in-set
[params params-to-remove]
(for [param params
:when (not (contains? params-to-remove (keyword (:slug param))))]
param)) |
Gets the params in both the provided embedding-params and dashboard-or-card object that we should remove. | (defn- get-params-to-remove
[dashboard-or-card embedding-params]
(set (concat (for [[param status] embedding-params
:when (not= status "enabled")]
param)
(for [{slug :slug} (:parameters dashboard-or-card)
:let [param (keyword slug)]
:when (not (contains? embedding-params param))]
param)))) |
Remove the | (mu/defn ^:private remove-locked-and-disabled-params
[dashboard-or-card embedding-params :- ms/EmbeddingParams]
(let [params-to-remove (get-params-to-remove dashboard-or-card embedding-params)]
(update dashboard-or-card :parameters remove-params-in-set params-to-remove))) |
Removes any parameters with slugs matching keys provided in | (defn- remove-token-parameters [dashboard-or-card token-params] (update dashboard-or-card :parameters remove-params-in-set (set (keys token-params)))) |
For any dashboard parameters with slugs matching keys provided in | (defn- substitute-token-parameters-in-text
[dashboard token-params]
(let [params (:parameters dashboard)
dashcards (:dashcards dashboard)
params-with-values (reduce
(fn [acc param]
(if-let [value (get token-params (keyword (:slug param)))]
(conj acc (assoc param :value value))
acc))
[]
params)]
(assoc dashboard
:dashcards
(map
(fn [card]
(if (-> card :visualization_settings :virtual_card)
(pulse-params/process-virtual-dashcard card params-with-values)
card))
dashcards)))) |
(mu/defn ^:private apply-slug->value :- [:maybe [:sequential
[:map
[:slug ms/NonBlankString]
[:type :keyword]
[:target :any]
[:value :any]]]]
"Adds `value` to parameters with `slug` matching a key in `merged-slug->value` and removes parameters without a
`value`."
[parameters slug->value]
(when (seq parameters)
(for [param parameters
:let [slug (keyword (:slug param))
value (get slug->value slug)
;; operator parameters expect a sequence of values so if we get a lone value (e.g. from a single URL
;; query parameter) wrap it in a sequence
value (if (and (some? value)
(params.ops/operator? (:type param)))
(u/one-or-many value)
value)]
:when (contains? slug->value slug)]
(assoc (select-keys param [:type :target :slug])
:value value)))) | |
Returns parameters for a card (HUH?) | (defn- resolve-card-parameters
; TODO - better docstring
[card-or-id]
(-> (t2/select-one [Card :dataset_query :parameters], :id (u/the-id card-or-id))
api.public/combine-parameters-and-template-tags
:parameters)) |
(mu/defn ^:private resolve-dashboard-parameters :- [:sequential api.dashboard/ParameterWithID]
"Given a `dashboard-id` and parameters map in the format `slug->value`, return a sequence of parameters with `:id`s
that can be passed to various functions in the `metabase.api.dashboard` namespace such as
[[metabase.api.dashboard/run-query-for-dashcard-async]]."
[dashboard-id :- ms/PositiveInt
slug->value :- :map]
(let [parameters (t2/select-one-fn :parameters Dashboard :id dashboard-id)
slug->id (into {} (map (juxt :slug :id)) parameters)]
(vec (for [[slug value] slug->value
:let [slug (u/qualified-name slug)]]
{:slug slug
:id (or (get slug->id slug)
(throw (ex-info (tru "No matching parameter with slug {0}. Found: {1}" (pr-str slug) (pr-str (keys slug->id)))
{:status-code 400
:slug slug
:dashboard-parameters parameters})))
:value value})))) | |
(mu/defn ^:private normalize-query-params :- [:map-of :keyword :any]
"Take a map of `query-params` and make sure they're in the right format for the rest of our code. Our
`wrap-keyword-params` middleware normally converts all query params keys to keywords, but only if they seem like
ones that make sense as keywords. Some params, such as ones that start with a number, do not pass this test, and are
not automatically converted. Thus we must do it ourselves here to make sure things are done as we'd expect.
Also, any param values that are blank strings should be parsed as nil, representing the absence of a value."
[query-params]
(-> query-params
(update-keys keyword)
(update-vals (fn [v] (if (= v ) nil v))))) | |
---------------------------- Card Fns used by both /api/embed and /api/preview_embed ----------------------------- | |
Return the info needed for embedding about Card specified in | (defn card-for-unsigned-token
[unsigned-token & {:keys [embedding-params constraints]}]
{:pre [((some-fn empty? sequential?) constraints) (even? (count constraints))]}
(let [card-id (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :question])
token-params (embed/get-in-unsigned-token-or-throw unsigned-token [:params])]
(-> (apply api.public/public-card :id card-id, constraints)
api.public/combine-parameters-and-template-tags
(remove-token-parameters token-params)
(remove-locked-and-disabled-params (or embedding-params
(t2/select-one-fn :embedding_params Card :id card-id)))))) |
Run the query associated with Card with | (defn run-query-for-card-with-params-async
{:style/indent 0}
[& {:keys [export-format card-id embedding-params token-params query-params qp-runner constraints options]
:or {qp-runner qp/process-query-and-save-execution!}}]
{:pre [(integer? card-id) (u/maybe? map? embedding-params) (map? token-params) (map? query-params)]}
(let [merged-slug->value (validate-and-merge-params embedding-params token-params (normalize-query-params query-params))
parameters (apply-slug->value (resolve-card-parameters card-id) merged-slug->value)]
(m/mapply api.public/run-query-for-card-with-id-async
card-id export-format parameters
:context :embedded-question,
:constraints constraints,
:qp-runner qp-runner,
options))) |
-------------------------- Dashboard Fns used by both /api/embed and /api/preview_embed -------------------------- | |
(defn- remove-linked-filters-param-values [dashboard]
(let [param-ids (set (map :id (:parameters dashboard)))
param-ids-to-remove (set (for [{param-id :id
filtering-parameters :filteringParameters} (:parameters dashboard)
filtering-parameter-id filtering-parameters
:when (not (contains? param-ids filtering-parameter-id))]
param-id))
linked-field-ids (set (mapcat (params/get-linked-field-ids (:dashcards dashboard)) param-ids-to-remove))]
(update dashboard :param_values #(->> %
(map (fn [[param-id param]]
{param-id (cond-> param
(contains? linked-field-ids param-id) ;; is param linked?
(assoc :values []))}))
(into {}))))) | |
(defn- remove-locked-parameters [dashboard embedding-params]
(let [params-to-remove (get-params-to-remove dashboard embedding-params)
param-ids-to-remove (set (for [parameter (:parameters dashboard)
:when (contains? params-to-remove (keyword (:slug parameter)))]
(:id parameter)))
linked-field-ids (set (mapcat (params/get-linked-field-ids (:dashcards dashboard)) param-ids-to-remove))
remove-parameters (fn [dashcard]
(update dashcard :parameter_mappings
(fn [param-mappings]
(remove (fn [{:keys [parameter_id]}]
(contains? param-ids-to-remove parameter_id)) param-mappings))))]
(-> dashboard
(update :dashcards #(map remove-parameters %))
(update :param_fields #(apply dissoc % linked-field-ids))
(update :param_values #(apply dissoc % linked-field-ids))))) | |
Return the info needed for embedding about Dashboard specified in | (defn dashboard-for-unsigned-token
[unsigned-token & {:keys [embedding-params constraints]}]
{:pre [((some-fn empty? sequential?) constraints) (even? (count constraints))]}
(let [dashboard-id (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :dashboard])
embedding-params (or embedding-params
(t2/select-one-fn :embedding_params Dashboard, :id dashboard-id))
token-params (embed/get-in-unsigned-token-or-throw unsigned-token [:params])]
(-> (apply api.public/public-dashboard :id dashboard-id, constraints)
(substitute-token-parameters-in-text token-params)
(remove-locked-parameters embedding-params)
(remove-token-parameters token-params)
(remove-locked-and-disabled-params embedding-params)
(remove-linked-filters-param-values)))) |
If a certain export-format is given, return the correct embedded dashboard context. | (defn- get-embed-dashboard-context
[export-format]
(case export-format
"csv" :embedded-csv-download
"xlsx" :embedded-xlsx-download
"json" :embedded-json-download
:embedded-dashboard)) |
Return results for running the query belonging to a DashboardCard. Returns a | (defn dashcard-results-async
{:style/indent 0}
[& {:keys [dashboard-id dashcard-id card-id export-format embedding-params token-params middleware
query-params constraints qp-runner]
:or {constraints (qp.constraints/default-query-constraints)
qp-runner qp/process-query-and-save-execution!}}]
{:pre [(integer? dashboard-id) (integer? dashcard-id) (integer? card-id) (u/maybe? map? embedding-params)
(map? token-params) (map? query-params)]}
(let [slug->value (validate-and-merge-params embedding-params token-params (normalize-query-params query-params))
parameters (resolve-dashboard-parameters dashboard-id slug->value)]
(api.public/public-dashcard-results-async
:dashboard-id dashboard-id
:card-id card-id
:dashcard-id dashcard-id
:export-format export-format
:parameters parameters
:qp-runner qp-runner
:context (get-embed-dashboard-context export-format)
:constraints constraints
:middleware middleware))) |
------------------------------------- Other /api/embed-specific utility fns -------------------------------------- | |
Check that embedding is enabled, that | (defn- check-embedding-enabled-for-object
([entity id]
(api/check (pos-int? id)
[400 (tru "{0} id should be a positive integer." (name entity))])
(check-embedding-enabled-for-object (t2/select-one [entity :enable_embedding] :id id)))
([object]
(validation/check-embedding-enabled)
(api/check-404 object)
(api/check-not-archived object)
(api/check (:enable_embedding object)
[400 (tru "Embedding is not enabled for this object.")]))) |
Runs check-embedding-enabled-for-object for a given Dashboard id | (def ^:private ^{:arglists '([dashboard-id])} check-embedding-enabled-for-dashboard
(partial check-embedding-enabled-for-object Dashboard)) |
Runs check-embedding-enabled-for-object for a given Card id | (def ^:private ^{:arglists '([card-id])} check-embedding-enabled-for-card
(partial check-embedding-enabled-for-object Card)) |
------------------------------------------- /api/embed/card endpoints -------------------------------------------- | |
/card/:token | (api/defendpoint GET
"Fetch a Card via a JSON Web Token signed with the `embedding-secret-key`.
Token should have the following format:
{:resource {:question <card-id>}}"
[token]
(let [unsigned (embed/unsign token)]
(check-embedding-enabled-for-card (embed/get-in-unsigned-token-or-throw unsigned [:resource :question]))
(card-for-unsigned-token unsigned, :constraints [:enable_embedding true]))) |
Run the query belonging to Card identified by | (defn ^:private run-query-for-unsigned-token-async
[unsigned-token export-format query-params & {:keys [constraints qp-runner]
:or {constraints (qp.constraints/default-query-constraints)
qp-runner qp/process-query-and-save-execution!}
:as options}]
(let [card-id (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :question])]
(check-embedding-enabled-for-card card-id)
(run-query-for-card-with-params-async
:export-format export-format
:card-id card-id
:token-params (embed/get-in-unsigned-token-or-throw unsigned-token [:params])
:embedding-params (t2/select-one-fn :embedding_params Card :id card-id)
:query-params query-params
:qp-runner qp-runner
:constraints constraints
:options options))) |
/card/:token/query | (api/defendpoint GET
"Fetch the results of running a Card using a JSON Web Token signed with the `embedding-secret-key`.
Token should have the following format:
{:resource {:question <card-id>}
:params <parameters>}"
[token & query-params]
(run-query-for-unsigned-token-async (embed/unsign token) :api query-params)) |
(api/defendpoint GET ["/card/:token/query/:export-format", :export-format api.dataset/export-format-regex]
"Like `GET /api/embed/card/query`, but returns the results as a file in the specified format."
[token export-format :as {:keys [query-params]}]
{export-format (into [:enum] api.dataset/export-formats)}
(run-query-for-unsigned-token-async
(embed/unsign token)
export-format
(m/map-keys keyword query-params)
:constraints nil
:middleware {:process-viz-settings? true
:js-int-to-string? false
:format-rows? false})) | |
----------------------------------------- /api/embed/dashboard endpoints ----------------------------------------- | |
/dashboard/:token | (api/defendpoint GET
"Fetch a Dashboard via a JSON Web Token signed with the `embedding-secret-key`.
Token should have the following format:
{:resource {:dashboard <dashboard-id>}}"
[token]
(let [unsigned (embed/unsign token)]
(check-embedding-enabled-for-dashboard (embed/get-in-unsigned-token-or-throw unsigned [:resource :dashboard]))
(u/prog1 (dashboard-for-unsigned-token unsigned, :constraints [:enable_embedding true])
(events/publish-event! :event/dashboard-read {:user-id api/*current-user-id*
:object <>})))) |
Fetch the results of running a Card belonging to a Dashboard using a JSON Web Token signed with the
Token should have the following format: {:resource {:dashboard Additional dashboard parameters can be provided in the query string, but params in the JWT token take precedence. Returns a | (defn- dashcard-results-for-signed-token-async
{:style/indent 1}
[token dashcard-id card-id export-format query-params
& {:keys [constraints qp-runner middleware]
:or {constraints (qp.constraints/default-query-constraints)
qp-runner qp/process-query-and-save-execution!}}]
(let [unsigned-token (embed/unsign token)
dashboard-id (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :dashboard])]
(check-embedding-enabled-for-dashboard dashboard-id)
(dashcard-results-async
:export-format export-format
:dashboard-id dashboard-id
:dashcard-id dashcard-id
:card-id card-id
:embedding-params (t2/select-one-fn :embedding_params Dashboard :id dashboard-id)
:token-params (embed/get-in-unsigned-token-or-throw unsigned-token [:params])
:query-params query-params
:constraints constraints
:qp-runner qp-runner
:middleware middleware))) |
/dashboard/:token/dashcard/:dashcard-id/card/:card-id | (api/defendpoint GET
"Fetch the results of running a Card belonging to a Dashboard using a JSON Web Token signed with the
`embedding-secret-key`"
[token dashcard-id card-id & query-params]
{dashcard-id ms/PositiveInt
card-id ms/PositiveInt}
(dashcard-results-for-signed-token-async token dashcard-id card-id :api query-params)) |
+----------------------------------------------------------------------------------------------------------------+ | FieldValues, Search, Remappings | +----------------------------------------------------------------------------------------------------------------+ | |
-------------------------------------------------- Field Values -------------------------------------------------- | |
/card/:token/field/:field-id/values | (api/defendpoint GET
"Fetch FieldValues for a Field that is referenced by an embedded Card."
[token field-id]
{field-id ms/PositiveInt}
(let [unsigned-token (embed/unsign token)
card-id (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :question])]
(check-embedding-enabled-for-card card-id)
(api.public/card-and-field-id->values card-id field-id))) |
/dashboard/:token/field/:field-id/values | (api/defendpoint GET
"Fetch FieldValues for a Field that is used as a param in an embedded Dashboard."
[token field-id]
{field-id ms/PositiveInt}
(let [unsigned-token (embed/unsign token)
dashboard-id (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :dashboard])]
(check-embedding-enabled-for-dashboard dashboard-id)
(api.public/dashboard-and-field-id->values dashboard-id field-id))) |
--------------------------------------------------- Searching ---------------------------------------------------- | |
/card/:token/field/:field-id/search/:search-field-id | (api/defendpoint GET
"Search for values of a Field that is referenced by an embedded Card."
[token field-id search-field-id value limit]
{field-id ms/PositiveInt
search-field-id ms/PositiveInt
value ms/NonBlankString
limit [:maybe ms/PositiveInt]}
(let [unsigned-token (embed/unsign token)
card-id (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :question])]
(check-embedding-enabled-for-card card-id)
(api.public/search-card-fields card-id field-id search-field-id value (when limit (Integer/parseInt limit))))) |
/dashboard/:token/field/:field-id/search/:search-field-id | (api/defendpoint GET
"Search for values of a Field that is referenced by a Card in an embedded Dashboard."
[token field-id search-field-id value limit]
{field-id ms/PositiveInt
search-field-id ms/PositiveInt
value ms/NonBlankString
limit [:maybe ms/PositiveInt]}
(let [unsigned-token (embed/unsign token)
dashboard-id (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :dashboard])]
(check-embedding-enabled-for-dashboard dashboard-id)
(api.public/search-dashboard-fields dashboard-id field-id search-field-id value (when limit
(Integer/parseInt limit))))) |
--------------------------------------------------- Remappings --------------------------------------------------- | |
/card/:token/field/:field-id/remapping/:remapped-id | (api/defendpoint GET
"Fetch remapped Field values. This is the same as `GET /api/field/:id/remapping/:remapped-id`, but for use with
embedded Cards."
[token field-id remapped-id value]
{field-id ms/PositiveInt
remapped-id ms/PositiveInt
value ms/NonBlankString}
(let [unsigned-token (embed/unsign token)
card-id (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :question])]
(check-embedding-enabled-for-card card-id)
(api.public/card-field-remapped-values card-id field-id remapped-id value))) |
/dashboard/:token/field/:field-id/remapping/:remapped-id | (api/defendpoint GET
"Fetch remapped Field values. This is the same as `GET /api/field/:id/remapping/:remapped-id`, but for use with
embedded Dashboards."
[token field-id remapped-id value]
{field-id ms/PositiveInt
remapped-id ms/PositiveInt
value ms/NonBlankString}
(let [unsigned-token (embed/unsign token)
dashboard-id (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :dashboard])]
(check-embedding-enabled-for-dashboard dashboard-id)
(api.public/dashboard-field-remapped-values dashboard-id field-id remapped-id value))) |
(api/defendpoint GET ["/dashboard/:token/dashcard/:dashcard-id/card/:card-id/:export-format"
:export-format api.dataset/export-format-regex]
"Fetch the results of running a Card belonging to a Dashboard using a JSON Web Token signed with the
`embedding-secret-key` return the data in one of the export formats"
[token export-format dashcard-id card-id, :as {:keys [query-params]}]
{dashcard-id ms/PositiveInt
card-id ms/PositiveInt
export-format (into [:enum] api.dataset/export-formats)}
(dashcard-results-for-signed-token-async token
dashcard-id
card-id
export-format
(m/map-keys keyword query-params)
:constraints nil
:middleware {:process-viz-settings? true
:js-int-to-string? false
:format-rows? false})) | |
----------------------------------------------- Param values ------------------------------------------------- | |
embedding parameters in variables whose name includes | |
(mu/defn ^:private param-values-merged-params :- [:map-of ms/NonBlankString :any]
[id->slug slug->id embedding-params token-params id-query-params]
(let [slug-query-params (into {}
(for [[id v] id-query-params]
[(or (get id->slug (name id))
(throw (ex-info (tru "Invalid query params: could not determine slug for parameter with ID {0}"
(pr-str id))
{:id (name id)
:id->slug id->slug
:id-query-params id-query-params})))
v]))
slug-query-params (normalize-query-params slug-query-params)
merged-slug->value (validate-and-merge-params embedding-params token-params slug-query-params)]
(into {} (for [[slug value] merged-slug->value]
[(get slug->id (name slug)) value])))) | |
Search for card parameter values. Does security checks to ensure the parameter is on the card and then gets param values according to [[api.card/param-values]]. | (defn card-param-values
[{:keys [unsigned-token card param-key search-prefix]}]
(let [slug-token-params (embed/get-in-unsigned-token-or-throw unsigned-token [:params])
parameters (or (seq (:parameters card))
(card/template-tag-parameters card))
id->slug (into {} (map (juxt :id :slug) parameters))
slug->id (into {} (map (juxt :slug :id) parameters))
searched-param-slug (get id->slug param-key)
embedding-params (:embedding_params card)]
(try
(when-not (= (get embedding-params (keyword searched-param-slug)) "enabled")
(throw (ex-info (tru "Cannot search for values: {0} is not an enabled parameter."
(pr-str searched-param-slug))
{:status-code 400})))
(when (get slug-token-params (keyword searched-param-slug))
(throw (ex-info (tru "You can''t specify a value for {0} if it's already set in the JWT." (pr-str searched-param-slug))
{:status-code 400})))
(try
(binding [api/*current-user-permissions-set* (atom #{"/"})]
(api.card/param-values card param-key search-prefix))
(catch Throwable e
(throw (ex-info (.getMessage e)
{:card-id (u/the-id card)
:param-key param-key
:search-prefix search-prefix}
e))))
(catch Throwable e
(let [e (ex-info (.getMessage e)
{:card-id (u/the-id card)
:card-params (:parametres card)
:allowed-param-slugs embedding-params
:slug->id slug->id
:id->slug id->slug
:param-id param-key
:param-slug searched-param-slug
:token-params slug-token-params}
e)]
(log/errorf e "embedded card-param-values error\n%s"
(u/pprint-to-str (u/all-ex-data e)))
(throw e)))))) |
(defn- dashboard-param-values [token searched-param-id prefix id-query-params]
(let [unsigned-token (embed/unsign token)
dashboard-id (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :dashboard])
_ (check-embedding-enabled-for-dashboard dashboard-id)
slug-token-params (embed/get-in-unsigned-token-or-throw unsigned-token [:params])
{parameters :parameters
embedding-params :embedding_params} (t2/select-one Dashboard :id dashboard-id)
id->slug (into {} (map (juxt :id :slug) parameters))
slug->id (into {} (map (juxt :slug :id) parameters))
searched-param-slug (get id->slug searched-param-id)]
(try
;; you can only search for values of a parameter if it is ENABLED and NOT PRESENT in the JWT.
(when-not (= (get embedding-params (keyword searched-param-slug)) "enabled")
(throw (ex-info (tru "Cannot search for values: {0} is not an enabled parameter." (pr-str searched-param-slug))
{:status-code 400})))
(when (get slug-token-params (keyword searched-param-slug))
(throw (ex-info (tru "You can''t specify a value for {0} if it's already set in the JWT." (pr-str searched-param-slug))
{:status-code 400})))
;; ok, at this point we can run the query
(let [merged-id-params (param-values-merged-params id->slug slug->id embedding-params slug-token-params id-query-params)]
(try
(binding [api/*current-user-permissions-set* (atom #{"/"})]
(api.dashboard/param-values (t2/select-one Dashboard :id dashboard-id) searched-param-id merged-id-params prefix))
(catch Throwable e
(throw (ex-info (.getMessage e)
{:merged-id-params merged-id-params}
e)))))
(catch Throwable e
(let [e (ex-info (.getMessage e)
{:dashboard-id dashboard-id
:dashboard-params parameters
:allowed-param-slugs embedding-params
:slug->id slug->id
:id->slug id->slug
:param-id searched-param-id
:param-slug searched-param-slug
:token-params slug-token-params}
e)]
(log/errorf e "Chain filter error\n%s" (u/pprint-to-str (u/all-ex-data e)))
(throw e)))))) | |
/dashboard/:token/params/:param-key/values | (api/defendpoint GET
"Embedded version of chain filter values endpoint."
[token param-key :as {:keys [query-params]}]
(dashboard-param-values token param-key nil query-params)) |
/dashboard/:token/params/:param-key/search/:prefix | (api/defendpoint GET
"Embedded version of chain filter search endpoint."
[token param-key prefix :as {:keys [query-params]}]
(dashboard-param-values token param-key prefix query-params)) |
/card/:token/params/:param-key/values | (api/defendpoint GET
"Embedded version of api.card filter values endpoint."
[token param-key]
(let [unsigned (embed/unsign token)
card-id (embed/get-in-unsigned-token-or-throw unsigned [:resource :question])
card (t2/select-one Card :id card-id)]
(check-embedding-enabled-for-card card-id)
(card-param-values {:unsigned-token unsigned
:card card
:param-key param-key}))) |
/card/:token/params/:param-key/search/:prefix | (api/defendpoint GET
"Embedded version of chain filter search endpoint."
[token param-key prefix]
(let [unsigned (embed/unsign token)
card-id (embed/get-in-unsigned-token-or-throw unsigned [:resource :question])
card (t2/select-one Card :id card-id)]
(check-embedding-enabled-for-card card-id)
(card-param-values {:unsigned-token unsigned
:card card
:param-key param-key
:search-prefix prefix}))) |
/pivot/card/:token/query | (api/defendpoint GET
"Fetch the results of running a Card using a JSON Web Token signed with the `embedding-secret-key`.
Token should have the following format:
{:resource {:question <card-id>}
:params <parameters>}"
[token & query-params]
(run-query-for-unsigned-token-async (embed/unsign token) :api query-params :qp-runner qp.pivot/run-pivot-query)) |
/pivot/dashboard/:token/dashcard/:dashcard-id/card/:card-id | (api/defendpoint GET
"Fetch the results of running a Card belonging to a Dashboard using a JSON Web Token signed with the
`embedding-secret-key`"
[token dashcard-id card-id & query-params]
{dashcard-id ms/PositiveInt
card-id ms/PositiveInt}
(dashcard-results-for-signed-token-async token dashcard-id card-id :api query-params :qp-runner qp.pivot/run-pivot-query)) |
(api/define-routes) | |
(ns metabase.api.field (:require [clojure.string :as str] [compojure.core :refer [DELETE GET POST PUT]] [metabase.api.common :as api] [metabase.db.metadata-queries :as metadata-queries] [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.models.dimension :refer [Dimension]] [metabase.models.field :as field :refer [Field]] [metabase.models.field-values :as field-values :refer [FieldValues]] [metabase.models.interface :as mi] [metabase.models.params.chain-filter :as chain-filter] [metabase.models.params.field-values :as params.field-values] [metabase.models.permissions :as perms] [metabase.models.table :as table :refer [Table]] [metabase.query-processor :as qp] [metabase.related :as related] [metabase.server.middleware.offset-paging :as mw.offset-paging] [metabase.sync :as sync] [metabase.sync.concurrent :as sync.concurrent] [metabase.types :as types] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2]) (:import (java.text NumberFormat))) | |
(set! *warn-on-reflection* true) | |
--------------------------------------------- Basic CRUD Operations ---------------------------------------------- | |
(def ^:private default-max-field-search-limit 1000) | |
Schema for a valid | (def ^:private FieldVisibilityType (into [:enum] (map name field/visibility-types))) |
Does the Current User have segmented query permissions for | (defn- has-segmented-query-permissions?
[table]
(perms/set-has-full-permissions? @api/*current-user-permissions-set*
(perms/table-sandboxed-query-path table))) |
Validates that the user either has full read permissions for | (defn- throw-if-no-read-or-segmented-perms
[field]
(when-not (or (mi/can-read? field)
(has-segmented-query-permissions? (field/table field)))
(api/throw-403))) |
/:id | (api/defendpoint GET
"Get `Field` with ID."
[id include_editable_data_model]
{id ms/PositiveInt
include_editable_data_model ms/BooleanValue}
(let [field (-> (api/check-404 (t2/select-one Field :id id))
(t2/hydrate [:table :db] :has_field_values :dimensions :name_field))
field (if include_editable_data_model
(field/hydrate-target-with-write-perms field)
(t2/hydrate field :target))]
;; Normal read perms = normal access.
;;
;; There's also a special case where we allow you to fetch a Field even if you don't have full read permissions for
;; it: if you have segmented query access to the Table it belongs to. In this case, we'll still let you fetch the
;; Field, since this is required to power features like Dashboard filters, but we'll treat this Field a little
;; differently in other endpoints such as the FieldValues fetching endpoint.
;;
;; Check for permissions and throw 403 if we don't have them...
(if include_editable_data_model
(api/write-check Table (:table_id field))
(throw-if-no-read-or-segmented-perms field))
;; ...but if we do, return the Field <3
field)) |
(defn- clear-dimension-on-fk-change! [{:keys [dimensions], :as _field}]
(doseq [{dimension-id :id, dimension-type :type} dimensions]
(when (and dimension-id (= :external dimension-type))
(t2/delete! Dimension :id dimension-id)))) | |
(defn- removed-fk-semantic-type? [old-semantic-type new-semantic-type]
(and (not= old-semantic-type new-semantic-type)
(isa? old-semantic-type :type/FK)
(or (nil? new-semantic-type)
(not (isa? new-semantic-type :type/FK))))) | |
(defn- internal-remapping-allowed? [base-type semantic-type]
(and (isa? base-type :type/Integer)
(or
(nil? semantic-type)
(isa? semantic-type :type/Category)
(isa? semantic-type :type/Enum)))) | |
Removes a related dimension if the field is moving to a type that does not support remapping | (defn- clear-dimension-on-type-change!
[{:keys [dimensions], :as _old-field} base-type new-semantic-type]
(doseq [{old-dim-id :id, old-dim-type :type} dimensions]
(when (and old-dim-id
(= :internal old-dim-type)
(not (internal-remapping-allowed? base-type new-semantic-type)))
(t2/delete! Dimension :id old-dim-id)))) |
If JSON unfolding was enabled for a JSON field, it activates previously synced nested fields from the JSON field. If JSON unfolding was disabled for that field, it inactivates the nested fields from the JSON field. Returns nil. | (defn- update-nested-fields-on-json-unfolding-change!
[old-field new-json-unfolding]
(when (not= new-json-unfolding (:json_unfolding old-field))
(if new-json-unfolding
(let [update-result (t2/update! Field
:table_id (:table_id old-field)
:nfc_path [:like (str "[\"" (:name old-field) "\",%]")]
{:active true})]
(when (zero? update-result)
;; Sync the table if no nested fields exist. This means the table hasn't previously
;; been synced when JSON unfolding was enabled. This assumes the JSON field is already updated to have
;; JSON unfolding enabled.
(let [table (field/table old-field)]
(sync.concurrent/submit-task (fn [] (sync/sync-table! table))))))
(t2/update! Field
:table_id (:table_id old-field)
:nfc_path [:like (str "[\"" (:name old-field) "\",%]")]
{:active false})))
nil) |
/:id | (api/defendpoint PUT
"Update `Field` with ID."
[id :as {{:keys [caveats description display_name fk_target_field_id points_of_interest semantic_type
coercion_strategy visibility_type has_field_values settings nfc_path json_unfolding]
:as body} :body}]
{id ms/PositiveInt
caveats [:maybe ms/NonBlankString]
description [:maybe ms/NonBlankString]
display_name [:maybe ms/NonBlankString]
fk_target_field_id [:maybe ms/PositiveInt]
points_of_interest [:maybe ms/NonBlankString]
semantic_type [:maybe ms/FieldSemanticOrRelationTypeKeywordOrString]
coercion_strategy [:maybe ms/CoercionStrategyKeywordOrString]
visibility_type [:maybe FieldVisibilityType]
has_field_values [:maybe ::lib.schema.metadata/column.has-field-values]
settings [:maybe ms/Map]
nfc_path [:maybe [:sequential ms/NonBlankString]]
json_unfolding [:maybe :boolean]}
(let [field (t2/hydrate (api/write-check Field id) :dimensions)
new-semantic-type (keyword (get body :semantic_type (:semantic_type field)))
[effective-type coercion-strategy]
(or (when-let [coercion_strategy (keyword coercion_strategy)]
(let [effective (types/effective-type-for-coercion coercion_strategy)]
;; throw an error in an else branch?
(when (types/is-coercible? coercion_strategy (:base_type field) effective)
[effective coercion_strategy])))
[(:base_type field) nil])
removed-fk? (removed-fk-semantic-type? (:semantic_type field) new-semantic-type)
fk-target-field-id (get body :fk_target_field_id (:fk_target_field_id field))]
;; validate that fk_target_field_id is a valid Field
;; TODO - we should also check that the Field is within the same database as our field
(when fk-target-field-id
(api/checkp (t2/exists? Field :id fk-target-field-id)
:fk_target_field_id "Invalid target field"))
(when (and display_name
(not removed-fk?)
(not= (:display_name field) display_name))
(t2/update! Dimension :field_id id {:name display_name}))
;; everything checks out, now update the field
(api/check-500
(t2/with-transaction [_conn]
(when removed-fk?
(clear-dimension-on-fk-change! field))
(clear-dimension-on-type-change! field (:base_type field) new-semantic-type)
(t2/update! Field id
(u/select-keys-when (assoc body
:fk_target_field_id (when-not removed-fk? fk-target-field-id)
:effective_type effective-type
:coercion_strategy coercion-strategy)
:present #{:caveats :description :fk_target_field_id :points_of_interest :semantic_type :visibility_type
:coercion_strategy :effective_type :has_field_values :nfc_path :json_unfolding}
:non-nil #{:display_name :settings}))))
(when (some? json_unfolding)
(update-nested-fields-on-json-unfolding-change! field json_unfolding))
;; return updated field. note the fingerprint on this might be out of date if the task below would replace them
;; but that shouldn't matter for the datamodel page
(u/prog1 (-> (t2/select-one Field :id id)
(t2/hydrate :dimensions :has_field_values)
(field/hydrate-target-with-write-perms))
(when (not= effective-type (:effective_type field))
(sync.concurrent/submit-task (fn [] (sync/refingerprint-field! <>))))))) |
------------------------------------------------- Field Metadata ------------------------------------------------- | |
/:id/summary | (api/defendpoint GET
"Get the count and distinct count of `Field` with ID."
[id]
{id ms/PositiveInt}
(let [field (api/read-check Field id)]
[[:count (metadata-queries/field-count field)]
[:distincts (metadata-queries/field-distinct-count field)]])) |
--------------------------------------------------- Dimensions --------------------------------------------------- | |
/:id/dimension | (api/defendpoint POST
"Sets the dimension for the given field at ID"
[id :as {{dimension-type :type, dimension-name :name, human_readable_field_id :human_readable_field_id} :body}]
{id ms/PositiveInt
dimension-type [:enum "internal" "external"]
dimension-name ms/NonBlankString
human_readable_field_id [:maybe ms/PositiveInt]}
(api/write-check Field id)
(api/check (or (= dimension-type "internal")
(and (= dimension-type "external")
human_readable_field_id))
[400 "Foreign key based remappings require a human readable field id"])
(if-let [dimension (t2/select-one Dimension :field_id id)]
(t2/update! Dimension (u/the-id dimension)
{:type dimension-type
:name dimension-name
:human_readable_field_id human_readable_field_id})
(t2/insert! Dimension
{:field_id id
:type dimension-type
:name dimension-name
:human_readable_field_id human_readable_field_id}))
(t2/select-one Dimension :field_id id)) |
/:id/dimension | (api/defendpoint DELETE
"Remove the dimension associated to field at ID"
[id]
{id ms/PositiveInt}
(api/write-check Field id)
(t2/delete! Dimension :field_id id)
api/generic-204-no-content) |
-------------------------------------------------- FieldValues --------------------------------------------------- | |
(def ^:private empty-field-values
{:values []}) | |
(declare search-values) | |
(mu/defn field->values :- ms/FieldValuesResult
"Fetch FieldValues, if they exist, for a `field` and return them in an appropriate format for public/embedded
use-cases."
[{has-field-values-type :has_field_values, field-id :id, has_more_values :has_more_values, :as field}]
;; TODO: explain why using remapped fields is restricted to `has_field_values=list`
(if-let [remapped-field-id (when (= has-field-values-type :list)
(chain-filter/remapped-field-id field-id))]
{:values (search-values (api/check-404 field)
(api/check-404 (t2/select-one Field :id remapped-field-id)))
:field_id field-id
:has_more_values (boolean has_more_values)}
(params.field-values/get-or-create-field-values-for-current-user! (api/check-404 field)))) | |
(mu/defn search-values-from-field-id :- ms/FieldValuesResult
"Search for values of a field given by `field-id` that contain `query`."
[field-id query]
(let [field (api/read-check (t2/select-one Field :id field-id))
search-field (or (some->> (chain-filter/remapped-field-id field-id)
(t2/select-one Field :id))
field)]
{:values (search-values field search-field query)
;; assume there are more if doing a search, otherwise there are no more values
:has_more_values (not (str/blank? query))
:field_id field-id})) | |
/:id/values | (api/defendpoint GET
"If a Field's value of `has_field_values` is `:list`, return a list of all the distinct values of the Field (or
remapped Field), and (if defined by a User) a map of human-readable remapped values. If `has_field_values` is not
`:list`, checks whether we should create FieldValues for this Field; if so, creates and returns them."
[id]
{id ms/PositiveInt}
(let [field (api/read-check (t2/select-one Field :id id))]
(field->values field))) |
/field%2C:field-name%2C:options/values match things like GET /field%2Ccreated_at%2options (this is how things like [field,created_at,{:base-type,:type/Datetime}] look when URL-encoded) | (api/defendpoint GET "Implementation of the field values endpoint for fields in the Saved Questions 'virtual' DB. This endpoint is just a convenience to simplify the frontend code. It just returns the standard 'empty' field values response." ;; we don't actually care what field-name or field-type are, so they're ignored [_ _] empty-field-values) |
Human readable values are optional, but if present they must be present for each field value. Throws if invalid, returns a boolean indicating whether human readable values were found. | (defn- validate-human-readable-pairs
[value-pairs]
(let [human-readable-missing? #(= ::not-found (get % 1 ::not-found))
has-human-readable-values? (not-any? human-readable-missing? value-pairs)]
(api/check (or has-human-readable-values?
(every? human-readable-missing? value-pairs))
[400 "If remapped values are specified, they must be specified for all field values"])
has-human-readable-values?)) |
(defn- update-field-values! [field-value-id value-pairs]
(let [human-readable-values? (validate-human-readable-pairs value-pairs)]
(api/check-500 (pos? (t2/update! FieldValues field-value-id
{:values (map first value-pairs)
:human_readable_values (when human-readable-values?
(map second value-pairs))}))))) | |
(defn- create-field-values!
[field-or-id value-pairs]
(let [human-readable-values? (validate-human-readable-pairs value-pairs)]
(t2/insert! FieldValues
:type :full
:field_id (u/the-id field-or-id)
:values (map first value-pairs)
:human_readable_values (when human-readable-values?
(map second value-pairs))))) | |
/:id/values | (api/defendpoint POST
"Update the fields values and human-readable values for a `Field` whose semantic type is
`category`/`city`/`state`/`country` or whose base type is `type/Boolean`. The human-readable values are optional."
[id :as {{value-pairs :values} :body}]
{id ms/PositiveInt
value-pairs [:sequential [:or [:tuple :any] [:tuple :any ms/NonBlankString]]]}
(let [field (api/write-check Field id)]
(api/check (field-values/field-should-have-field-values? field)
[400 (str "You can only update the human readable values of a mapped values of a Field whose value of "
"`has_field_values` is `list` or whose 'base_type' is 'type/Boolean'.")])
(if-let [field-value-id (t2/select-one-pk FieldValues, :field_id id :type :full)]
(update-field-values! field-value-id value-pairs)
(create-field-values! field value-pairs)))
{:status :success}) |
/:id/rescan_values | (api/defendpoint POST
"Manually trigger an update for the FieldValues for this Field. Only applies to Fields that are eligible for
FieldValues."
[id]
{id ms/PositiveInt}
(let [field (api/write-check (t2/select-one Field :id id))]
;; Override *current-user-permissions-set* so that permission checks pass during sync. If a user has DB detail perms
;; but no data perms, they should stll be able to trigger a sync of field values. This is fine because we don't
;; return any actual field values from this API. (#21764)
(binding [api/*current-user-permissions-set* (atom #{"/"})]
(field-values/create-or-update-full-field-values! field)))
{:status :success}) |
/:id/discard_values | (api/defendpoint POST
"Discard the FieldValues belonging to this Field. Only applies to fields that have FieldValues. If this Field's
Database is set up to automatically sync FieldValues, they will be recreated during the next cycle."
[id]
{id ms/PositiveInt}
(field-values/clear-field-values-for-field! (api/write-check (t2/select-one Field :id id)))
{:status :success}) |
--------------------------------------------------- Searching ---------------------------------------------------- | |
(defn- table-id [field] (u/the-id (:table_id field))) | |
(defn- db-id [field] (u/the-id (t2/select-one-fn :db_id Table :id (table-id field)))) | |
Automatically follow the target IDs in an FK (follow-fks <PEOPLE.ID Field>) ;-> <PEOPLE.ID Field> (follow-fks <REVIEWS.REVIEWER Field>) ;-> <PEOPLE.ID Field> This is used below to seamlessly handle either PK or FK Fields without having to think about which is which in the
| (defn- follow-fks
[{semantic-type :semantic_type, fk-target-field-id :fk_target_field_id, :as field}]
(if (and (isa? semantic-type :type/FK)
fk-target-field-id)
(t2/select-one Field :id fk-target-field-id)
field)) |
Generate the MBQL query used to power FieldValues search in [[search-values]] below. The actual query generated differs slightly based on whether the two Fields are the same Field. Note: the generated MBQL query assume that both | (defn- search-values-query
[field search-field value limit]
{:database (db-id field)
:type :query
:query {:source-table (table-id field)
:filter (when (some? value)
[:contains [:field (u/the-id search-field) nil] value {:case-sensitive false}])
;; if both fields are the same then make sure not to refer to it twice in the `:breakout` clause.
;; Otherwise this will break certain drivers like BigQuery that don't support duplicate
;; identifiers/aliases
:breakout (if (= (u/the-id field) (u/the-id search-field))
[[:field (u/the-id field) nil]]
[[:field (u/the-id field) nil]
[:field (u/the-id search-field) nil]])
:limit limit}}) |
(mu/defn search-values :- [:maybe ms/FieldValuesList]
"Search for values of `search-field` that contain `value` (up to `limit`, if specified), and return pairs like
[<value-of-field> <matching-value-of-search-field>].
If `search-field` and `field` are the same, simply return 1-tuples like
[<matching-value-of-field>].
For example, with the Sample Database, you could search for the first three IDs & names of People whose name
contains `Ma` as follows:
(search-values <PEOPLE.ID Field> <PEOPLE.NAME Field> \"Ma\" 3)
;; -> ((14 \"Marilyne Mohr\")
(36 \"Margot Farrell\")
(48 \"Maryam Douglas\"))"
([field search-field]
(search-values field search-field nil nil))
([field search-field value]
(search-values field search-field value nil))
([field
search-field
value :- [:maybe ms/NonBlankString]
maybe-limit :- [:maybe ms/PositiveInt]]
(try
(let [field (follow-fks field)
search-field (follow-fks search-field)
limit (or maybe-limit default-max-field-search-limit)
results (qp/process-query (search-values-query field search-field value limit))]
(get-in results [:data :rows]))
(catch Throwable e
(log/error e (trs "Error searching field values"))
nil)))) | |
/:id/search/:search-id | (api/defendpoint GET
"Search for values of a Field with `search-id` that start with `value`. See docstring for
`metabase.api.field/search-values` for a more detailed explanation."
[id search-id value]
{id ms/PositiveInt
search-id ms/PositiveInt
value ms/NonBlankString}
(let [field (api/check-404 (t2/select-one Field :id id))
search-field (api/check-404 (t2/select-one Field :id search-id))]
(throw-if-no-read-or-segmented-perms field)
(throw-if-no-read-or-segmented-perms search-field)
(search-values field search-field value mw.offset-paging/*limit*))) |
Search for one specific remapping where the value of
if a match is found. For example, with the Sample Database, you could find the name of the Person with ID 20 as follows:
| (defn remapped-value
[field remapped-field value]
(try
(let [field (follow-fks field)
results (qp/process-query
{:database (db-id field)
:type :query
:query {:source-table (table-id field)
:filter [:= [:field (u/the-id field) nil] value]
:fields [[:field (u/the-id field) nil]
[:field (u/the-id remapped-field) nil]]
:limit 1}})]
;; return first row if it exists
(first (get-in results [:data :rows])))
;; as with fn above this error can usually be safely ignored which is why log level is log/debug
(catch Throwable e
(log/debug e (trs "Error searching for remapping"))
nil))) |
Parse a | (defn parse-query-param-value-for-field
[field ^String value]
(if (isa? (:base_type field) :type/Number)
(.parse (NumberFormat/getInstance) value)
value)) |
/:id/remapping/:remapped-id | (api/defendpoint GET
"Fetch remapped Field values."
[id remapped-id value]
{id ms/PositiveInt
remapped-id ms/PositiveInt
value ms/NonBlankString}
(let [field (api/read-check Field id)
remapped-field (api/read-check Field remapped-id)
value (parse-query-param-value-for-field field value)]
(remapped-value field remapped-field value))) |
/:id/related | (api/defendpoint GET
"Return related entities."
[id]
{id ms/PositiveInt}
(-> (t2/select-one Field :id id) api/read-check related/related)) |
(api/define-routes) | |
(ns metabase.api.geojson (:require [clj-http.client :as http] [clojure.java.io :as io] [compojure.core :refer [GET]] [malli.core :as mc] [metabase.api.common :as api] [metabase.api.common.validation :as validation] [metabase.models.setting :as setting :refer [defsetting]] [metabase.util.i18n :refer [deferred-tru tru]] [metabase.util.malli.schema :as ms] [ring.util.codec :as codec] [ring.util.response :as response]) (:import (java.io BufferedReader) (java.net InetAddress URL) (org.apache.commons.io.input ReaderInputStream))) | |
(set! *warn-on-reflection* true) | |
(defsetting custom-geojson-enabled (deferred-tru "Whether or not the use of custom GeoJSON is enabled.") :visibility :admin :export? true :type :boolean :setter :none :default true :audit :getter) | |
(def ^:private CustomGeoJSON
[:map-of :keyword [:map {:closed true}
[:name ms/NonBlankString]
[:url ms/NonBlankString]
[:region_key [:maybe :string]]
[:region_name [:maybe :string]]
[:builtin {:optional true} :boolean]]]) | |
(def ^:private CustomGeoJSONValidator (mc/validator CustomGeoJSON)) | |
(def ^:private builtin-geojson
{:us_states {:name "United States"
:url "app/assets/geojson/us-states.json"
:region_key "STATE"
:region_name "NAME"
:builtin true}
:world_countries {:name "World"
:url "app/assets/geojson/world.json"
:region_key "ISO_A2"
:region_name "NAME"
:builtin true}}) | |
(defn- invalid-location-msg []
(str (tru "Invalid GeoJSON file location: must either start with http:// or https:// or be a relative path to a file on the classpath.")
" "
(tru "URLs referring to hosts that supply internal hosting metadata are prohibited."))) | |
(def ^:private invalid-hosts
#{"metadata.google.internal"}) ; internal metadata for GCP | |
(defn- valid-host?
[^URL url]
(let [host (.getHost url)
host->url (fn [host] (URL. (str "http://" host)))
base-url (host->url (.getHost url))]
(and (not-any? (fn [invalid-url] (.equals ^URL base-url invalid-url))
(map host->url invalid-hosts))
(not (.isLinkLocalAddress (InetAddress/getByName host)))))) | |
(defn- valid-protocol?
[^URL url]
(#{"http" "https"} (.getProtocol url))) | |
(defn- valid-url?
[url-string]
(try
(let [url (URL. url-string)]
(and (valid-protocol? url)
(valid-host? url)))
(catch Throwable e
(throw (ex-info (invalid-location-msg) {:status-code 400, :url url-string} e))))) | |
(defn- valid-geojson-url?
[url]
(or (io/resource url)
(valid-url? url))) | |
(defn- valid-geojson-urls?
[geojson]
(every? (fn [[_ {:keys [url]}]] (valid-geojson-url? url))
geojson)) | |
Throws a 400 if the supplied | (defn- validate-geojson
[geojson]
(when-not (CustomGeoJSONValidator geojson)
(throw (ex-info (tru "Invalid custom GeoJSON") {:status-code 400})))
(or (valid-geojson-urls? geojson)
(throw (ex-info (invalid-location-msg) {:status-code 400})))) |
(defsetting custom-geojson
(deferred-tru "JSON containing information about custom GeoJSON files for use in map visualizations instead of the default US State or World GeoJSON.")
:type :json
:default {}
:getter (fn [] (merge (setting/get-value-of-type :json :custom-geojson) builtin-geojson))
:setter (fn [new-value]
;; remove the built-in keys you can't override them and we don't want those to be subject to validation.
(let [new-value (not-empty (reduce dissoc new-value (keys builtin-geojson)))]
(when new-value
(validate-geojson new-value))
(setting/set-value-of-type! :json :custom-geojson new-value)))
:visibility :public
:export? true
:audit :raw-value) | |
(def ^:private connection-timeout-ms 8000) | |
Reads the provided URL and responds with the contents as a stream. | (defn- read-url-and-respond
[url respond]
(with-open [^BufferedReader reader (if-let [resource (io/resource url)]
(io/reader resource)
(:body (http/get url {:as :reader
:redirect-strategy :none
:socket-timeout connection-timeout-ms
:connection-timeout connection-timeout-ms})))
is (ReaderInputStream. reader)]
(respond (-> (response/response is)
(response/content-type "application/json"))))) |
/:key | (api/defendpoint-async GET
"Fetch a custom GeoJSON file as defined in the `custom-geojson` setting. (This just acts as a simple proxy for the
file specified for `key`)."
[{{:keys [key]} :params} respond raise]
{key ms/NonBlankString}
(when-not (or (custom-geojson-enabled) (builtin-geojson (keyword key)))
(raise (ex-info (tru "Custom GeoJSON is not enabled") {:status-code 400})))
(if-let [url (get-in (custom-geojson) [(keyword key) :url])]
(try
(read-url-and-respond url respond)
(catch Throwable _e
(raise (ex-info (tru "GeoJSON URL failed to load") {:status-code 400}))))
(raise (ex-info (tru "Invalid custom GeoJSON key: {0}" key) {:status-code 400})))) |
/ | (api/defendpoint-async GET
"Load a custom GeoJSON file based on a URL or file path provided as a query parameter.
This behaves similarly to /api/geojson/:key but doesn't require the custom map to be saved to the DB first."
[{{:keys [url]} :params} respond raise]
{url ms/NonBlankString}
(validation/check-has-application-permission :setting)
(when-not (custom-geojson-enabled)
(raise (ex-info (tru "Custom GeoJSON is not enabled") {:status-code 400})))
(let [decoded-url (codec/url-decode url)]
(try
(when-not (valid-geojson-url? decoded-url)
(throw (ex-info (invalid-location-msg) {:status-code 400})))
(try
(read-url-and-respond decoded-url respond)
(catch Throwable _
(throw (ex-info (tru "GeoJSON URL failed to load") {:status-code 400}))))
(catch Throwable e
(raise e))))) |
(api/define-routes) | |
/api/google endpoints | (ns metabase.api.google (:require [compojure.core :refer [PUT]] [metabase.api.common :as api] [metabase.integrations.google :as google] [metabase.models.setting :as setting] [toucan2.core :as t2])) |
/settings | (api/defendpoint PUT
"Update Google Sign-In related settings. You must be a superuser to do this."
[:as {{:keys [google-auth-client-id google-auth-enabled google-auth-auto-create-accounts-domain]} :body}]
{google-auth-client-id [:maybe :string]
google-auth-enabled [:maybe :boolean]
google-auth-auto-create-accounts-domain [:maybe :string]}
(api/check-superuser)
;; Set google-auth-enabled in a separate step because it requires the client ID to be set first
(t2/with-transaction [_conn]
(setting/set-many! {:google-auth-client-id google-auth-client-id
:google-auth-auto-create-accounts-domain google-auth-auto-create-accounts-domain})
(google/google-auth-enabled! google-auth-enabled))) |
(api/define-routes) | |
/api/ldap endpoints | (ns metabase.api.ldap (:require [clojure.set :as set] [compojure.core :refer [PUT]] [metabase.api.common :as api] [metabase.integrations.ldap :as ldap] [metabase.models.setting :as setting :refer [defsetting]] [metabase.util.i18n :refer [deferred-tru tru]] [metabase.util.log :as log] [toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
Convert raw error message responses from our LDAP tests into our normal api error response structure. | (defn- humanize-error-messages
[{:keys [status message]}]
(when (not= :SUCCESS status)
(log/warn "Problem connecting to LDAP server:" message)
(let [conn-error {:errors {:ldap-host "Wrong host or port"
:ldap-port "Wrong host or port"}}
security-error {:errors {:ldap-port "Wrong port or security setting"
:ldap-security "Wrong port or security setting"}}
bind-dn-error {:errors {:ldap-bind-dn "Wrong bind DN"}}
creds-error {:errors {:ldap-bind-dn "Wrong bind DN or password"
:ldap-password "Wrong bind DN or password"}}]
(condp re-matches message
#".*UnknownHostException.*"
conn-error
#".*ConnectException.*"
conn-error
#".*SocketException.*"
security-error
#".*SSLException.*"
security-error
#"^For input string.*"
{:errors {:ldap-host "Invalid hostname, do not add the 'ldap://' or 'ldaps://' prefix"}}
#".*password was incorrect.*"
{:errors {:ldap-password "Password was incorrect"}}
#"^Unable to bind as user.*"
bind-dn-error
#"^Unable to parse bind DN.*"
{:errors {:ldap-bind-dn "Invalid bind DN"}}
#".*AcceptSecurityContext error, data 525,.*"
bind-dn-error
#".*AcceptSecurityContext error, data 52e,.*"
creds-error
#".*AcceptSecurityContext error, data 532,.*"
{:errors {:ldap-password "Password is expired"}}
#".*AcceptSecurityContext error, data 533,.*"
{:errors {:ldap-bind-dn "Account is disabled"}}
#".*AcceptSecurityContext error, data 701,.*"
{:errors {:ldap-bind-dn "Account is expired"}}
#"^User search base does not exist .*"
{:errors {:ldap-user-base "User search base does not exist or is unreadable"}}
#"^Group search base does not exist .*"
{:errors {:ldap-group-base "Group search base does not exist or is unreadable"}}
;; everything else :(
#"(?s).*"
{:message message})))) |
(defsetting ldap-enabled
(deferred-tru "Is LDAP currently enabled?")
:type :boolean
:visibility :public
:setter (fn [new-value]
(let [new-value (boolean new-value)]
(when new-value
;; Test the LDAP settings before enabling
(let [result (ldap/test-current-ldap-details)]
(when-not (= :SUCCESS (:status result))
(throw (ex-info (tru "Unable to connect to LDAP server with current settings")
(humanize-error-messages result))))))
(setting/set-value-of-type! :boolean :ldap-enabled new-value)))
:default false
:audit :getter) | |
Do not update password if | (defn- update-password-if-needed
[new-password]
(let [current-password (setting/get :ldap-password)]
(if (= (setting/obfuscate-value current-password) new-password)
current-password
new-password))) |
/settings | (api/defendpoint PUT
"Update LDAP related settings. You must be a superuser to do this."
[:as {settings :body}]
{settings :map}
(api/check-superuser)
(let [ldap-settings (-> settings
(select-keys (keys ldap/mb-settings->ldap-details))
(assoc :ldap-port (when-let [^String ldap-port (not-empty (str (:ldap-port settings)))]
(Long/parseLong ldap-port)))
(update :ldap-password update-password-if-needed))
ldap-details (set/rename-keys ldap-settings ldap/mb-settings->ldap-details)
results (ldap/test-ldap-connection ldap-details)]
(if (= :SUCCESS (:status results))
(t2/with-transaction [_conn]
(setting/set-many! ldap-settings)
(setting/set-value-of-type! :boolean :ldap-enabled (boolean (:ldap-enabled settings))))
;; test failed, return result message
{:status 500
:body (humanize-error-messages results)}))) |
(api/define-routes) | |
(ns metabase.api.login-history (:require [compojure.core :refer [GET]] [metabase.api.common :as api] [metabase.models.login-history :as login-history :refer [LoginHistory]] [metabase.util :as u] [toucan2.core :as t2])) | |
Return complete login history (sorted by most-recent -> least-recent) for | (defn login-history
[user-or-id]
;; TODO -- should this only return history in some window, e.g. last 3 months? I think for auditing purposes it's
;; nice to be able to see every log in that's every happened with an account. Maybe we should page this, or page the
;; API endpoint?
(login-history/human-friendly-infos
(t2/select [LoginHistory :timestamp :session_id :device_description :ip_address]
:user_id (u/the-id user-or-id)
{:order-by [[:timestamp :desc]]}))) |
/current | (api/defendpoint GET "Fetch recent logins for the current user." [] (login-history api/*current-user-id*)) |
(api/define-routes) | |
These Metabot endpoints are for an experimental feature. | (ns metabase.api.metabot (:require [clojure.string :as str] [compojure.core :refer [POST]] [metabase.api.common :as api] [metabase.metabot :as metabot] [metabase.metabot.feedback :as metabot-feedback] [metabase.metabot.util :as metabot-util] [metabase.models :refer [Card Database]] [metabase.util.log :as log] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
Do a preliminary check to ensure metabot will work. Throw an exception if not. | (defn- check-database-support
[database-id]
(when-not (metabot-util/supported? database-id)
(throw
(let [message "Metabot is not supported for this database type."]
(ex-info
message
{:status-code 400
:message message}))))) |
An http-friendly version of infer-sql that throws a useful error if it fails to produce sql. | (defn- infer-sql-or-throw
[context question]
(or
(metabot/infer-sql context)
(throw
(let [message (format
"Query '%s' didn't produce any SQL. Perhaps try a more detailed query."
question)]
(ex-info
message
{:status-code 400
:message message}))))) |
Given a calling context and resulting dataset, add a more interesting visual to the card. | (defn- add-viz-to-dataset
[context {:keys [bot-sql] :as dataset}]
(let [context (assoc context :sql bot-sql :prompt_task :infer_viz)
{:keys [template prompt_template_version]} (metabot/infer-viz context)]
(cond-> (update dataset :card merge template)
prompt_template_version
(update :prompt_template_versions conj prompt_template_version)))) |
/model/:model-id | (api/defendpoint POST
"Ask Metabot to generate a SQL query given a prompt about a given model."
[model-id :as {{:keys [question]} :body}]
{model-id ms/PositiveInt
question ms/NonBlankString}
(log/infof
"Metabot '/api/metabot/model/%s' being called with prompt: '%s'"
model-id
question)
(let [model (api/check-404 (t2/select-one Card :id model-id :dataset true))
_ (check-database-support (:database_id model))
context {:model (metabot-util/denormalize-model model)
:user_prompt question
:prompt_task :infer_sql}
dataset (infer-sql-or-throw context question)]
(add-viz-to-dataset context dataset))) |
/database/:database-id | (api/defendpoint POST
"Ask Metabot to generate a native question given a prompt about a given database."
[database-id :as {{:keys [question]} :body}]
{database-id ms/PositiveInt
question ms/NonBlankString}
(log/infof
"Metabot '/api/metabot/database/%s' being called with prompt: '%s'"
database-id
question)
(let [{:as database} (api/check-404 (t2/select-one Database :id database-id))
_ (check-database-support (:id database))
context {:database (metabot-util/denormalize-database database)
:user_prompt question
:prompt_task :infer_model}]
(if-some [model (metabot/infer-model context)]
(let [context (merge context {:model model :prompt_task :infer_sql})
dataset (infer-sql-or-throw context question)]
(add-viz-to-dataset context dataset))
(throw
(let [message (format
(str/join
" "
["Query '%s' didn't find a good match to your data."
"Perhaps try a query that mentions the model name or columns more specifically."])
question)]
(ex-info
message
{:status-code 400
:message message})))))) |
/database/:database-id/query | (api/defendpoint POST
"Ask Metabot to generate a SQL query given a prompt about a given database."
[database-id :as {{:keys [question]} :body}]
{database-id ms/PositiveInt
question ms/NonBlankString}
(log/infof
"Metabot '/api/metabot/database/%s/query' being called with prompt: '%s'"
database-id
question)
(let [{:as database} (api/check-404 (t2/select-one Database :id database-id))
_ (check-database-support (:id database))
context {:database (metabot-util/denormalize-database database)
:user_prompt question
:prompt_task :infer_native_sql}]
(metabot/infer-native-sql-query context))) |
/feedback | (api/defendpoint POST
"Record feedback on metabot results."
[:as {feedback :body}]
(if-some [stored-feedback (metabot-feedback/submit-feedback feedback)]
{:feedback stored-feedback
:message "Thanks for your feedback"}
(throw
(let [message "There was a problem submitting your feedback."]
(ex-info
message
{:status-code 500
:message message}))))) |
(api/define-routes) | |
/api/metric endpoints. | (ns metabase.api.metric (:require [clojure.data :as data] [compojure.core :refer [DELETE GET POST PUT]] [metabase.api.common :as api] [metabase.events :as events] [metabase.mbql.normalize :as mbql.normalize] [metabase.models :refer [Metric MetricImportantField Table]] [metabase.models.interface :as mi] [metabase.models.revision :as revision] [metabase.related :as related] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
/ | (api/defendpoint POST
"Create a new `Metric`."
[:as {{:keys [name description table_id definition], :as body} :body}]
{name ms/NonBlankString
table_id ms/PositiveInt
definition :map
description [:maybe :string]}
;; TODO - why can't set the other properties like `show_in_getting_started` when you create a Metric?
(api/create-check Metric body)
(let [metric (api/check-500
(first (t2/insert-returning-instances! Metric
:table_id table_id
:creator_id api/*current-user-id*
:name name
:description description
:definition definition)))]
(events/publish-event! :event/metric-create {:object metric :user-id api/*current-user-id*})
(t2/hydrate metric :creator))) |
(mu/defn ^:private hydrated-metric [id :- ms/PositiveInt]
(-> (api/read-check (t2/select-one Metric :id id))
(t2/hydrate :creator))) | |
/:id | (api/defendpoint GET
"Fetch `Metric` with ID."
[id]
{id ms/PositiveInt}
(hydrated-metric id)) |
Add | (defn- add-db-ids
[metrics]
(when (seq metrics)
(let [table-id->db-id (t2/select-pk->fn :db_id Table, :id [:in (set (map :table_id metrics))])]
(for [metric metrics]
(assoc metric :database_id (table-id->db-id (:table_id metric))))))) |
/ | (api/defendpoint GET
"Fetch *all* `Metrics`."
[]
(as-> (t2/select Metric, :archived false, {:order-by [:%lower.name]}) metrics
(t2/hydrate metrics :creator :definition_description)
(add-db-ids metrics)
(filter mi/can-read? metrics)
metrics)) |
Check whether current user has write permissions, then update Metric with values in | (defn- write-check-and-update-metric!
[id {:keys [revision_message] :as body}]
(let [existing (api/write-check Metric id)
clean-body (u/select-keys-when body
:present #{:description :caveats :how_is_this_calculated :points_of_interest}
:non-nil #{:archived :definition :name :show_in_getting_started})
new-def (->> clean-body :definition (mbql.normalize/normalize-fragment []))
new-body (merge
(dissoc clean-body :revision_message)
(when new-def {:definition new-def}))
changes (when-not (= new-body existing)
new-body)
archive? (:archived changes)]
(when changes
(t2/update! Metric id changes))
(u/prog1 (hydrated-metric id)
(events/publish-event! (if archive? :event/metric-delete :event/metric-update)
{:object <> :user-id api/*current-user-id* :revision-message revision_message})))) |
/:id | (api/defendpoint PUT
"Update a `Metric` with ID."
[id :as {{:keys [name definition revision_message archived caveats description how_is_this_calculated
points_of_interest show_in_getting_started]
:as body} :body}]
{id ms/PositiveInt
name [:maybe ms/NonBlankString]
definition [:maybe :map]
revision_message ms/NonBlankString
archived [:maybe :boolean]
caveats [:maybe :string]
description [:maybe :string]
how_is_this_calculated [:maybe :string]
points_of_interest [:maybe :string]
show_in_getting_started [:maybe :boolean]}
(write-check-and-update-metric! id body)) |
/:id/important_fields | (api/defendpoint PUT
"Update the important `Fields` for a `Metric` with ID.
(This is used for the Getting Started guide)."
[id :as {{:keys [important_field_ids]} :body}]
{id ms/PositiveInt
important_field_ids [:sequential ms/PositiveInt]}
(api/check-superuser)
(api/write-check Metric id)
(api/check (<= (count important_field_ids) 3)
[400 "A Metric can have a maximum of 3 important fields."])
(let [[fields-to-remove fields-to-add] (data/diff (set (t2/select-fn-set :field_id 'MetricImportantField :metric_id id))
(set important_field_ids))]
;; delete old fields as needed
(when (seq fields-to-remove)
(t2/delete! (t2/table-name MetricImportantField) {:metric_id id, :field_id [:in fields-to-remove]}))
;; add new fields as needed
(t2/insert! 'MetricImportantField (for [field-id fields-to-add]
{:metric_id id, :field_id field-id}))
{:success true})) |
/:id | (api/defendpoint DELETE
"Archive a Metric. (DEPRECATED -- Just pass updated value of `:archived` to the `PUT` endpoint instead.)"
[id revision_message]
{id ms/PositiveInt
revision_message ms/NonBlankString}
(log/warn
(trs "DELETE /api/metric/:id is deprecated. Instead, change its `archived` value via PUT /api/metric/:id."))
(write-check-and-update-metric! id {:archived true, :revision_message revision_message})
api/generic-204-no-content) |
/:id/revisions | (api/defendpoint GET
"Fetch `Revisions` for `Metric` with ID."
[id]
{id ms/PositiveInt}
(api/read-check Metric id)
(revision/revisions+details Metric id)) |
/:id/revert | (api/defendpoint POST
"Revert a `Metric` to a prior `Revision`."
[id :as {{:keys [revision_id]} :body}]
{id ms/PositiveInt
revision_id ms/PositiveInt}
(api/write-check Metric id)
(revision/revert!
{:entity Metric
:id id
:user-id api/*current-user-id*
:revision-id revision_id})) |
/:id/related | (api/defendpoint GET
"Return related entities."
[id]
{id ms/PositiveInt}
(-> (t2/select-one Metric :id id) api/read-check related/related)) |
(api/define-routes) | |
(ns metabase.api.model-index (:require [compojure.core :refer [POST]] [metabase.analytics.snowplow :as snowplow] [metabase.api.common :as api] [metabase.mbql.normalize :as mbql.normalize] [metabase.models.card :refer [Card]] [metabase.models.model-index :as model-index :refer [ModelIndex]] [metabase.task.index-values :as task.index-values] [metabase.util.i18n :refer [tru]] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) | |
Ensure that the ref exists and is of type required for indexing. | (defn- ensure-type
[t ref metadata]
(if-let [field (some (fn [f] (when ((comp #{(mbql.normalize/normalize-field-ref ref)} :field_ref) f)
f))
metadata)]
(let [type-slot (case t
:type/PK :semantic_type
(:type/Integer :type/Text) :effective_type)]
(when-not (isa? (type-slot field) t)
(throw (ex-info (tru "Field is not of {0} `{1}`" type-slot t)
{:status-code 400
:expected-type t
:type (:effective_type field)
:field (:name field)}))))
(throw (ex-info (tru "Could not identify field by ref {0}" ref)
{:status-code 400
:ref ref
:fields metadata})))) |
/ | (api/defendpoint POST
[:as {{:keys [model_id pk_ref value_ref] :as _model-index} :body}]
{model_id ms/PositiveInt
pk_ref any?
value_ref any?}
(let [model (api/write-check Card model_id)
metadata (:result_metadata model)]
(when-not (seq metadata)
(throw (ex-info (tru "Model has no metadata. Cannot index")
{:model-id model_id})))
(ensure-type :type/PK pk_ref metadata)
(ensure-type :type/Integer pk_ref metadata)
(ensure-type :type/Text value_ref metadata)
;; todo: do we care if there's already an index on that model?
(let [model-index (model-index/create {:model-id model_id
:pk-ref pk_ref
:value-ref value_ref
:creator-id api/*current-user-id*})]
(snowplow/track-event! ::snowplow/index-model-entities-enabled api/*current-user-id* {:model-id model_id})
(task.index-values/add-indexing-job model-index)
(model-index/add-values! model-index)
(t2/select-one ModelIndex :id (:id model-index))))) |
/ | (api/defendpoint GET
[model_id]
{model_id ms/PositiveInt}
(let [model (api/read-check Card model_id)]
(when-not (:dataset model)
(throw (ex-info (tru "Question {0} is not a model" model_id)
{:model_id model_id
:status-code 400})))
(t2/select ModelIndex :model_id model_id))) |
/:id | (api/defendpoint GET
[id]
{id ms/PositiveInt}
(let [model-index (api/check-404 (t2/select-one ModelIndex :id id))
model (api/read-check Card (:model_id model-index))]
(when-not (:dataset model)
(throw (ex-info (tru "Question {0} is not a model" id)
{:model_id id
:status-code 400})))
model-index)) |
/:id | (api/defendpoint DELETE
[id]
{id ms/PositiveInt}
(api/let-404 [model-index (t2/select-one ModelIndex :id id)]
(api/write-check Card (:model_id model-index))
(t2/delete! ModelIndex id))) |
(api/define-routes) | |
Native query snippet (/api/native-query-snippet) endpoints. | (ns metabase.api.native-query-snippet
(:require
[clojure.data :as data]
[compojure.core :refer [GET POST PUT]]
[metabase.api.common :as api]
[metabase.models.interface :as mi]
[metabase.models.native-query-snippet
:as native-query-snippet
:refer [NativeQuerySnippet]]
[metabase.util :as u]
[metabase.util.i18n :refer [tru]]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
(mu/defn ^:private hydrated-native-query-snippet :- [:maybe (mi/InstanceOf NativeQuerySnippet)]
[id :- ms/PositiveInt]
(-> (api/read-check (t2/select-one NativeQuerySnippet :id id))
(t2/hydrate :creator))) | |
/ | (api/defendpoint GET
"Fetch all snippets"
[archived]
{archived [:maybe ms/BooleanString]}
(let [snippets (t2/select NativeQuerySnippet
:archived (Boolean/parseBoolean archived)
{:order-by [[:%lower.name :asc]]})]
(t2/hydrate (filter mi/can-read? snippets) :creator))) |
/:id | (api/defendpoint GET
"Fetch native query snippet with ID."
[id]
{id ms/PositiveInt}
(hydrated-native-query-snippet id)) |
(defn- check-snippet-name-is-unique [snippet-name]
(when (t2/exists? NativeQuerySnippet :name snippet-name)
(throw (ex-info (tru "A snippet with that name already exists. Please pick a different name.")
{:status-code 400})))) | |
/ | (api/defendpoint POST
"Create a new `NativeQuerySnippet`."
[:as {{:keys [content description name collection_id]} :body}]
{content :string
description [:maybe :string]
name native-query-snippet/NativeQuerySnippetName
collection_id [:maybe ms/PositiveInt]}
(check-snippet-name-is-unique name)
(let [snippet {:content content
:creator_id api/*current-user-id*
:description description
:name name
:collection_id collection_id}]
(api/create-check NativeQuerySnippet snippet)
(api/check-500 (first (t2/insert-returning-instances! NativeQuerySnippet snippet))))) |
Check whether current user has write permissions, then update NativeQuerySnippet with values in | (defn- check-perms-and-update-snippet!
[id body]
(let [snippet (t2/select-one NativeQuerySnippet :id id)
body-fields (u/select-keys-when body
:present #{:description :collection_id}
:non-nil #{:archived :content :name})
[changes] (data/diff body-fields snippet)]
(when (seq changes)
(api/update-check snippet changes)
(when-let [new-name (:name changes)]
(check-snippet-name-is-unique new-name))
(t2/update! NativeQuerySnippet id changes))
(hydrated-native-query-snippet id))) |
/:id | (api/defendpoint PUT
"Update an existing `NativeQuerySnippet`."
[id :as {{:keys [archived content description name collection_id] :as body} :body}]
{id ms/PositiveInt
archived [:maybe :boolean]
content [:maybe :string]
description [:maybe :string]
name [:maybe native-query-snippet/NativeQuerySnippetName]
collection_id [:maybe ms/PositiveInt]}
(check-perms-and-update-snippet! id body)) |
(api/define-routes) | |
/api/notify/* endpoints which receive inbound etl server notifications. | (ns metabase.api.notify (:require [compojure.core :refer [POST]] [metabase.api.common :as api] [metabase.driver :as driver] [metabase.driver.util :as driver.u] [metabase.models.database :refer [Database]] [metabase.models.table :refer [Table]] [metabase.sync :as sync] [metabase.sync.sync-metadata :as sync-metadata] [metabase.sync.sync-metadata.tables :as sync-tables] [metabase.sync.util :as sync-util] [metabase.util.i18n :refer [trs]] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
/db/:id | (api/defendpoint POST
"Notification about a potential schema change to one of our `Databases`.
Caller can optionally specify a `:table_id` or `:table_name` in the body to limit updates to a single
`Table`. Optional Parameter `:scan` can be `\"full\"` or `\"schema\"` for a full sync or a schema sync, available
regardless if a `:table_id` or `:table_name` is passed.
This endpoint is secured by an API key that needs to be passed as a `X-METABASE-APIKEY` header which needs to be defined in
the `MB_API_KEY` [environment variable](https://www.metabase.com/docs/latest/configuring-metabase/environment-variables.html#mb_api_key)"
[id :as {{:keys [table_id table_name scan synchronous?]} :body}]
{id ms/PositiveInt
table_id [:maybe ms/PositiveInt]
table_name [:maybe ms/NonBlankString]
scan [:maybe [:enum "full" "schema"]]}
(let [schema? (when scan (#{"schema" :schema} scan))
table-sync-fn (if schema? sync-metadata/sync-table-metadata! sync/sync-table!)
db-sync-fn (if schema? sync-metadata/sync-db-metadata! sync/sync-database!)]
(api/let-404 [database (t2/select-one Database :id id)]
(cond-> (cond
table_id (api/let-404 [table (t2/select-one Table :db_id id, :id (int table_id))]
(future (table-sync-fn table)))
table_name (api/let-404 [table (t2/select-one Table :db_id id, :name table_name)]
(future (table-sync-fn table)))
:else (future (db-sync-fn database)))
synchronous? deref)))
{:success true}) |
(defn- without-stacktrace [^Throwable throwable]
(doto throwable
(.setStackTrace (make-array StackTraceElement 0)))) | |
/db/:id/new-table | (api/defendpoint POST
"Sync a new table without running a full database sync. Requires `schema_name` and `table_name`. Will throw an error
if the table already exists in Metabase or cannot be found."
[id :as {{:keys [schema_name table_name]} :body}]
{id ms/PositiveInt
schema_name ms/NonBlankString
table_name ms/NonBlankString}
(api/let-404 [database (t2/select-one Database :id id)]
(if-not (t2/select-one Table :db_id id :name table_name :schema schema_name)
(let [driver (driver.u/database->driver database)
{db-tables :tables} (driver/describe-database driver database)]
(if-let [table (some (fn [table-in-db]
(when (= (dissoc table-in-db :description)
{:schema schema_name :name table_name})
table-in-db))
db-tables)]
(let [created (sync-tables/create-or-reactivate-table! database table)]
(doto created
sync/sync-table!
sync-util/set-initial-table-sync-complete!))
(throw (without-stacktrace
(ex-info (trs "Unable to identify table ''{0}.{1}''"
schema_name table_name)
{:status-code 404
:schema_name schema_name
:table_name table_name})))))
(throw (without-stacktrace
(ex-info (trs "Table ''{0}.{1}'' already exists"
schema_name table_name)
{:status-code 400
:schema_name schema_name
:table_name table_name})))))) |
(api/define-routes) | |
Convert the permission graph's naive json conversion into the correct types. The strategy here is to use s/conform to tag every value that needs to be converted with the conversion strategy, then postwalk to actually perform the conversion. | (ns metabase.api.permission-graph (:require [clojure.spec.alpha :as s] [clojure.spec.gen.alpha :as gen] [clojure.walk :as walk] [metabase.util :as u] [metabase.util.i18n :refer [trs]])) |
(set! *warn-on-reflection* true) | |
convert values from the naively converted json to what we REALLY WANT | (defmulti ^:private convert first) |
(defmethod convert :kw->int [[_ k]] (Integer/parseInt (name k))) (defmethod convert :str->kw [[_ s]] (keyword s)) | |
Convert a keyword to string without excluding the namespace. e.g: :schema/name => "schema/name". Primarily used for schema-name since schema are allowed to have "/" and calling (name s) returning a substring after "/". | (defmethod convert :kw->str [[_ s]] (u/qualified-name s)) (defmethod convert :nil->none [[_ _]] :none) (defmethod convert :identity [[_ x]] x) (defmethod convert :global-execute [[_ x]] x) (defmethod convert :db-exeute [[_ x]] x) |
--------------------------------------------------- Common ---------------------------------------------------- | |
(defn- kw-int->int-decoder [kw-int]
(if (int? kw-int)
kw-int
(parse-long (name kw-int)))) | |
Integer malli schema that knows how to decode itself from the :123 sort of shape used in perm-graphs | (def DecodableKwInt
[:int {:decode/perm-graph kw-int->int-decoder}]) |
(def ^:private Id DecodableKwInt) (def ^:private GroupId DecodableKwInt) | |
ids come in as keywordized numbers | (s/def ::id (s/with-gen (s/or :kw->int (s/and keyword? #(re-find #"^\d+$" (name %))))
#(gen/fmap (comp keyword str) (s/gen pos-int?)))) |
native permissions | (def ^:private Native [:maybe [:enum :write :none :full :limited]]) |
------------------------------------------------ Data Permissions ------------------------------------------------ | |
(def ^:private TablePerms
[:or
[:enum :all :segmented :none :full :limited]
[:map
[:read {:optional true} [:enum :all :none]]
[:query {:optional true} [:enum :all :none :segmented]]]]) | |
(def ^:private SchemaPerms
[:or
[:keyword {:title "schema name"}]
[:map-of Id TablePerms]]) | |
(def ^:private SchemaGraph
[:map-of
[:string {:decode/perm-graph name}]
SchemaPerms]) | |
(def ^:private Schemas [:or [:enum :all :segmented :none :block :full :limited :impersonated] SchemaGraph]) | |
(def ^:private DataPerms
[:map
[:native {:optional true} Native]
[:schemas {:optional true} Schemas]]) | |
data perms that care about how native and schemas keys related to one another. If you have write access for native queries, you must have data access to all schemas. | (def StrictDataPerms
[:and
DataPerms
[:fn {:error/fn (fn [_ _] (trs "Invalid DB permissions: If you have write access for native queries, you must have data access to all schemas."))}
(fn [{:keys [native schemas]}]
(not (and (= native :write) schemas (not (#{:all :impersonated} schemas)))))]]) |
(def ^:private DbGraph
[:schema {:registry {"DataPerms" DataPerms}}
[:map-of
Id
[:map
[:data {:optional true} "DataPerms"]
[:query {:optional true} "DataPerms"]
[:download {:optional true} "DataPerms"]
[:data-model {:optional true} "DataPerms"]
;; We use :yes and :no instead of booleans for consistency with the application perms graph, and
;; consistency with the language used on the frontend.
[:details {:optional true} [:enum :yes :no]]
[:execute {:optional true} [:enum :all :none]]]]]) | |
like db-graph, but if you have write access for native queries, you must have data access to all schemas. | (def StrictDbGraph
[:schema {:registry {"StrictDataPerms" StrictDataPerms}}
[:map-of
Id
[:map
[:data {:optional true} "StrictDataPerms"]
[:query {:optional true} "StrictDataPerms"]
[:download {:optional true} "StrictDataPerms"]
[:data-model {:optional true} "StrictDataPerms"]
;; We use :yes and :no instead of booleans for consistency with the application perms graph, and
;; consistency with the language used on the frontend.
[:details {:optional true} [:enum :yes :no]]
[:execute {:optional true} [:enum :all :none]]]]]) |
Used to transform, and verify data permissions graph | (def DataPermissionsGraph [:map [:groups [:map-of GroupId [:maybe DbGraph]]]]) |
Top level strict data graph schema | (def StrictData [:map [:groups [:map-of GroupId [:maybe StrictDbGraph]]] [:revision int?]]) |
--------------------------------------------- Execution Permissions ---------------------------------------------- | |
(s/def ::execute (s/or :str->kw #{"all" "none"})) | |
(s/def ::execute-graph
(s/or :global-execute ::execute
:db-exeute (s/map-of ::id ::execute
:conform-keys true))) | |
(s/def :metabase.api.permission-graph.execution/groups
(s/map-of ::id
::execute-graph
:conform-keys true)) | |
(s/def ::execution-permissions-graph (s/keys :req-un [:metabase.api.permission-graph.execution/groups])) | |
The permissions graph is received as JSON. That JSON is naively converted. This performs a further conversion to convert graph keys and values to the types we want to work with. | (defn converted-json->graph
[spec kwj]
(->> (s/conform spec kwj)
(walk/postwalk (fn [x]
(if (and (vector? x) (get-method convert (first x)))
(convert x)
x))))) |
/api/permissions endpoints. | (ns metabase.api.permissions
(:require
[clojure.spec.alpha :as s]
[compojure.core :refer [DELETE GET POST PUT]]
[honey.sql.helpers :as sql.helpers]
[malli.core :as mc]
[malli.transform :as mtx]
[metabase.api.common :as api]
[metabase.api.common.validation :as validation]
[metabase.api.permission-graph :as api.permission-graph]
[metabase.db.query :as mdb.query]
[metabase.models :refer [PermissionsGroupMembership User]]
[metabase.models.interface :as mi]
[metabase.models.permissions :as perms]
[metabase.models.permissions-group
:as perms-group
:refer [PermissionsGroup]]
[metabase.models.permissions-revision :as perms-revision]
[metabase.public-settings.premium-features
:as premium-features
:refer [defenterprise]]
[metabase.server.middleware.offset-paging :as mw.offset-paging]
[metabase.util :as u]
[metabase.util.i18n :refer [tru]]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[toucan2.core :as t2])) |
+----------------------------------------------------------------------------------------------------------------+ | PERMISSIONS GRAPH ENDPOINTS | +----------------------------------------------------------------------------------------------------------------+ | |
--------------------------------------------------- Endpoints ---------------------------------------------------- | |
/graph | (api/defendpoint GET "Fetch a graph of all v1 Permissions (excludes v2 query and data permissions)." [] (api/check-superuser) (perms/data-perms-graph)) |
/graph/db/:db-id | (api/defendpoint GET
"Fetch a graph of all v1 Permissions for db-id `db-id` (excludes v2 query and data permissions)."
[db-id]
{db-id ms/PositiveInt}
(api/check-superuser)
(perms/data-graph-for-db db-id)) |
/graph/group/:group-id | (api/defendpoint GET
"Fetch a graph of all v1 Permissions for group-id `group-id` (excludes v2 query and data permissions)."
[group-id]
{group-id ms/PositiveInt}
(api/check-superuser)
(perms/data-graph-for-group group-id)) |
/graph-v2 | (api/defendpoint GET "Fetch a graph of all v2 Permissions (excludes v1 data permissions)." [] (api/check-superuser) (perms/data-perms-graph-v2)) |
OSS implementation of | (defenterprise upsert-sandboxes! metabase-enterprise.sandbox.models.group-table-access-policy [_sandboxes] (throw (premium-features/ee-feature-error (tru "Sandboxes")))) |
OSS implementation of | (defenterprise insert-impersonations! metabase-enterprise.advanced-permissions.models.connection-impersonation [_impersonations] (throw (premium-features/ee-feature-error (tru "Connection impersonation")))) |
/graph | (api/defendpoint PUT
"Do a batch update of Permissions by passing in a modified graph. This should return the same graph, in the same
format, that you got from `GET /api/permissions/graph`, with any changes made in the wherever necessary. This
modified graph must correspond to the `PermissionsGraph` schema. If successful, this endpoint returns the updated
permissions graph; use this as a base for any further modifications.
Revisions to the permissions graph are tracked. If you fetch the permissions graph and some other third-party
modifies it before you can submit you revisions, the endpoint will instead make no changes and return a
409 (Conflict) response. In this case, you should fetch the updated graph and make desired changes to that.
The optional `sandboxes` key contains a list of sandboxes that should be created or modified in conjunction with
this permissions graph update. Since data sandboxing is an Enterprise Edition-only feature, a 402 (Payment Required)
response will be returned if this key is present and the server is not running the Enterprise Edition, and/or the
`:sandboxes` feature flag is not present.
If the skip-graph query param is truthy, then the graph will not be returned."
[:as {body :body
{skip-graph :skip-graph} :params}]
{body :map
skip-graph [:maybe :boolean]}
(api/check-superuser)
(let [graph (mc/decode api.permission-graph/DataPermissionsGraph
body
(mtx/transformer
mtx/string-transformer
(mtx/transformer {:name :perm-graph})))]
(when-not (mc/validate api.permission-graph/DataPermissionsGraph graph)
(let [explained (mu/explain api.permission-graph/DataPermissionsGraph graph)]
(throw (ex-info (tru "Cannot parse permissions graph because it is invalid: {0}" (pr-str explained))
{:status-code 400}))))
(t2/with-transaction [_conn]
(perms/update-data-perms-graph! (dissoc graph :sandboxes :impersonations))
(let [sandbox-updates (:sandboxes graph)
sandboxes (when sandbox-updates
(upsert-sandboxes! sandbox-updates))
impersonation-updates (:impersonations graph)
impersonations (when impersonation-updates
(insert-impersonations! impersonation-updates))]
(merge {:revision (perms-revision/latest-id)}
(when-not skip-graph {:groups (:groups (perms/data-perms-graph))})
(when sandboxes {:sandboxes sandboxes})
(when impersonations {:impersonations impersonations})))))) |
+----------------------------------------------------------------------------------------------------------------+ | PERMISSIONS GROUP ENDPOINTS | +----------------------------------------------------------------------------------------------------------------+ | |
Return a map of | (defn- group-id->num-members
[]
(let [results (mdb.query/query
{:select [[:pgm.group_id :group_id] [[:count :pgm.id] :members]]
:from [[:permissions_group_membership :pgm]]
:left-join [[:core_user :user] [:= :pgm.user_id :user.id]]
:where [:= :user.is_active true]
:group-by [:pgm.group_id]})]
(zipmap
(map :group_id results)
(map :members results)))) |
Return a sequence of ordered | (defn- ordered-groups
[limit offset query]
(t2/select PermissionsGroup
(cond-> {:order-by [:%lower.name]}
(some? limit) (sql.helpers/limit limit)
(some? offset) (sql.helpers/offset offset)
(some? query) (sql.helpers/where query)))) |
(mi/define-batched-hydration-method add-member-counts
:member_count
"Efficiently add `:member_count` to PermissionGroups."
[groups]
(let [group-id->num-members (group-id->num-members)]
(for [group groups]
(assoc group :member_count (get group-id->num-members (u/the-id group) 0))))) | |
/group | (api/defendpoint GET
"Fetch all `PermissionsGroups`, including a count of the number of `:members` in that group.
This API requires superuser or group manager of more than one group.
Group manager is only available if `advanced-permissions` is enabled and returns only groups that user
is manager of."
[]
(try
(validation/check-group-manager)
(catch clojure.lang.ExceptionInfo _e
(validation/check-has-application-permission :setting)))
(let [query (when (and (not api/*is-superuser?*)
(premium-features/enable-advanced-permissions?)
api/*is-group-manager?*)
[:in :id {:select [:group_id]
:from [:permissions_group_membership]
:where [:and
[:= :user_id api/*current-user-id*]
[:= :is_group_manager true]]}])]
(-> (ordered-groups mw.offset-paging/*limit* mw.offset-paging/*offset* query)
(t2/hydrate :member_count)))) |
/group/:id | (api/defendpoint GET
"Fetch the details for a certain permissions group."
[id]
{id ms/PositiveInt}
(validation/check-group-manager id)
(api/check-404
(-> (t2/select-one PermissionsGroup :id id)
(t2/hydrate :members)))) |
/group | (api/defendpoint POST
"Create a new `PermissionsGroup`."
[:as {{:keys [name]} :body}]
{name ms/NonBlankString}
(api/check-superuser)
(first (t2/insert-returning-instances! PermissionsGroup
:name name))) |
/group/:group-id | (api/defendpoint PUT
"Update the name of a `PermissionsGroup`."
[group-id :as {{:keys [name]} :body}]
{group-id ms/PositiveInt
name ms/NonBlankString}
(validation/check-manager-of-group group-id)
(api/check-404 (t2/exists? PermissionsGroup :id group-id))
(t2/update! PermissionsGroup group-id
{:name name})
;; return the updated group
(t2/select-one PermissionsGroup :id group-id)) |
/group/:group-id | (api/defendpoint DELETE
"Delete a specific `PermissionsGroup`."
[group-id]
{group-id ms/PositiveInt}
(validation/check-manager-of-group group-id)
(t2/delete! PermissionsGroup :id group-id)
api/generic-204-no-content) |
------------------------------------------- Group Membership Endpoints ------------------------------------------- | |
/membership | (api/defendpoint GET
"Fetch a map describing the group memberships of various users.
This map's format is:
{<user-id> [{:membership_id <id>
:group_id <id>
:is_group_manager boolean}]}"
[]
(validation/check-group-manager)
(group-by :user_id (t2/select [PermissionsGroupMembership [:id :membership_id] :group_id :user_id :is_group_manager]
(cond-> {}
(and (not api/*is-superuser?*)
api/*is-group-manager?*)
(sql.helpers/where
[:in :group_id {:select [:group_id]
:from [:permissions_group_membership]
:where [:and
[:= :user_id api/*current-user-id*]
[:= :is_group_manager true]]}]))))) |
/membership | (api/defendpoint POST
"Add a `User` to a `PermissionsGroup`. Returns updated list of members belonging to the group."
[:as {{:keys [group_id user_id is_group_manager]} :body}]
{group_id ms/PositiveInt
user_id ms/PositiveInt
is_group_manager [:maybe :boolean]}
(let [is_group_manager (boolean is_group_manager)]
(validation/check-manager-of-group group_id)
(when is_group_manager
;; enable `is_group_manager` require advanced-permissions enabled
(validation/check-advanced-permissions-enabled :group-manager)
(api/check
(t2/exists? User :id user_id :is_superuser false)
[400 (tru "Admin cant be a group manager.")]))
(t2/insert! PermissionsGroupMembership
:group_id group_id
:user_id user_id
:is_group_manager is_group_manager)
;; TODO - it's a bit silly to return the entire list of members for the group, just return the newly created one and
;; let the frontend add it as appropriate
(perms-group/members {:id group_id}))) |
/membership/:id | (api/defendpoint PUT
"Update a Permission Group membership. Returns the updated record."
[id :as {{:keys [is_group_manager]} :body}]
{id ms/PositiveInt
is_group_manager :boolean}
;; currently this API is only used to update the `is_group_manager` flag and it requires advanced-permissions
(validation/check-advanced-permissions-enabled :group-manager)
;; Make sure only Super user or Group Managers can call this
(validation/check-group-manager)
(let [old (t2/select-one PermissionsGroupMembership :id id)]
(api/check-404 old)
(validation/check-manager-of-group (:group_id old))
(api/check
(t2/exists? User :id (:user_id old) :is_superuser false)
[400 (tru "Admin cant be a group manager.")])
(t2/update! PermissionsGroupMembership (:id old)
{:is_group_manager is_group_manager})
(t2/select-one PermissionsGroupMembership :id (:id old)))) |
/membership/:group-id/clear | (api/defendpoint PUT
"Remove all members from a `PermissionsGroup`. Returns a 400 (Bad Request) if the group ID is for the admin group."
[group-id]
{group-id ms/PositiveInt}
(validation/check-manager-of-group group-id)
(api/check-404 (t2/exists? PermissionsGroup :id group-id))
(api/check-400 (not= group-id (u/the-id (perms-group/admin))))
(t2/delete! PermissionsGroupMembership :group_id group-id)
api/generic-204-no-content) |
/membership/:id | (api/defendpoint DELETE
"Remove a User from a PermissionsGroup (delete their membership)."
[id]
{id ms/PositiveInt}
(let [membership (t2/select-one PermissionsGroupMembership :id id)]
(api/check-404 membership)
(validation/check-manager-of-group (:group_id membership))
(t2/delete! PermissionsGroupMembership :id id)
api/generic-204-no-content)) |
------------------------------------------- Execution Endpoints ------------------------------------------- | |
/execution/graph | (api/defendpoint GET "Fetch a graph of execution permissions." [] (api/check-superuser) (perms/execution-perms-graph)) |
/execution/graph | (api/defendpoint PUT
"Do a batch update of execution permissions by passing in a modified graph. The modified graph of the same
form as returned by the corresponding GET endpoint.
Revisions to the permissions graph are tracked. If you fetch the permissions graph and some other third-party
modifies it before you can submit you revisions, the endpoint will instead make no changes and return a
409 (Conflict) response. In this case, you should fetch the updated graph and make desired changes to that."
[:as {body :body}]
{body [:map]}
(api/check-superuser)
;; TODO remove api.permission-graph/converted-json->graph call
(let [graph (api.permission-graph/converted-json->graph ::api.permission-graph/execution-permissions-graph body)]
(when (= graph :clojure.spec.alpha/invalid)
(throw (ex-info (tru "Invalid execution permission graph: {0}"
(s/explain-str ::api.permission-graph/execution-permissions-graph body))
{:status-code 400
:error (s/explain-data ::api.permission-graph/execution-permissions-graph body)})))
(perms/update-execution-perms-graph! graph))
(perms/execution-perms-graph)) |
(api/define-routes) | |
(ns metabase.api.persist
(:require
[clojure.string :as str]
[compojure.core :refer [GET POST]]
[honey.sql.helpers :as sql.helpers]
[medley.core :as m]
[metabase.api.common :as api]
[metabase.api.common.validation :as validation]
[metabase.driver.ddl.interface :as ddl.i]
[metabase.models.database :refer [Database]]
[metabase.models.interface :as mi]
[metabase.models.persisted-info
:as persisted-info
:refer [PersistedInfo]]
[metabase.public-settings :as public-settings]
[metabase.server.middleware.offset-paging :as mw.offset-paging]
[metabase.task.persist-refresh :as task.persist-refresh]
[metabase.util :as u]
[metabase.util.i18n :refer [deferred-tru tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[toucan2.core :as t2])) | |
(set! *warn-on-reflection* true) | |
Returns a list of persisted info, annotated with databasename, cardname, and schema_name. | (defn- fetch-persisted-info
[{:keys [persisted-info-id card-id db-ids]} limit offset]
(let [site-uuid-str (public-settings/site-uuid)
db-id->fire-time (task.persist-refresh/job-info-by-db-id)
query (cond-> {:select [:p.id :p.database_id :p.definition
:p.active :p.state :p.error
:p.refresh_begin :p.refresh_end
:p.table_name :p.creator_id
:p.card_id [:c.name :card_name]
[:c.archived :card_archived]
[:c.dataset :card_dataset]
[:db.name :database_name]
[:col.id :collection_id] [:col.name :collection_name]
[:col.authority_level :collection_authority_level]]
:from [[:persisted_info :p]]
:left-join [[:metabase_database :db] [:= :db.id :p.database_id]
[:report_card :c] [:= :c.id :p.card_id]
[:collection :col] [:= :c.collection_id :col.id]]
:order-by [[:p.refresh_begin :desc]]}
persisted-info-id (sql.helpers/where [:= :p.id persisted-info-id])
(seq db-ids) (sql.helpers/where [:in :p.database_id db-ids])
card-id (sql.helpers/where [:= :p.card_id card-id])
limit (sql.helpers/limit limit)
offset (sql.helpers/offset offset))]
(as-> (t2/select PersistedInfo query) results
(t2/hydrate results :creator)
(map (fn [{:keys [database_id] :as pi}]
(assoc pi
:schema_name (ddl.i/schema-name {:id database_id} site-uuid-str)
:next-fire-time (get-in db-id->fire-time [database_id :next-fire-time])))
results)))) |
/ | (api/defendpoint GET
"List the entries of [[PersistedInfo]] in order to show a status page."
[]
(validation/check-has-application-permission :monitoring)
(let [db-ids (t2/select-fn-set :database_id PersistedInfo)
writable-db-ids (when (seq db-ids)
(->> (t2/select Database :id [:in db-ids])
(filter mi/can-write?)
(map :id)
set))
persisted-infos (fetch-persisted-info {:db-ids writable-db-ids} mw.offset-paging/*limit* mw.offset-paging/*offset*)]
{:data persisted-infos
:total (if (seq writable-db-ids)
(t2/count PersistedInfo :database_id [:in writable-db-ids])
0)
:limit mw.offset-paging/*limit*
:offset mw.offset-paging/*offset*})) |
/:persisted-info-id | (api/defendpoint GET
"Fetch a particular [[PersistedInfo]] by id."
[persisted-info-id]
{persisted-info-id [:maybe ms/PositiveInt]}
(api/let-404 [persisted-info (first (fetch-persisted-info {:persisted-info-id persisted-info-id} nil nil))]
(api/write-check (t2/select-one Database :id (:database_id persisted-info)))
persisted-info)) |
/card/:card-id | (api/defendpoint GET
"Fetch a particular [[PersistedInfo]] by card-id."
[card-id]
{card-id [:maybe ms/PositiveInt]}
(api/let-404 [persisted-info (first (fetch-persisted-info {:card-id card-id} nil nil))]
(api/write-check (t2/select-one Database :id (:database_id persisted-info)))
persisted-info)) |
Schema representing valid cron schedule for refreshing persisted models. | (def ^:private CronSchedule
(mu/with-api-error-message
[:and
ms/NonBlankString
[:fn {:error/message (deferred-tru "String representing a cron schedule")} #(= 7 (count (str/split % #" ")))]]
(deferred-tru "Value must be a string representing a cron schedule of format <seconds> <minutes> <hours> <day of month> <month> <day of week> <year>"))) |
/set-refresh-schedule | (api/defendpoint POST
"Set the cron schedule to refresh persisted models.
Shape should be JSON like {cron: \"0 30 1/8 * * ? *\"}."
[:as {{:keys [cron], :as _body} :body}]
{cron CronSchedule}
(validation/check-has-application-permission :setting)
(when cron
(when-not (and (string? cron)
(org.quartz.CronExpression/isValidExpression cron)
(str/ends-with? cron "*"))
(throw (ex-info (tru "Must be a valid cron string not specifying a year")
{:status-code 400})))
(public-settings/persisted-model-refresh-cron-schedule! cron))
(task.persist-refresh/reschedule-refresh!)
api/generic-204-no-content) |
/enable | (api/defendpoint POST "Enable global setting to allow databases to persist models." [] (validation/check-has-application-permission :setting) (log/info (tru "Enabling model persistence")) (public-settings/persisted-models-enabled! true) (task.persist-refresh/enable-persisting!) api/generic-204-no-content) |
Disables persistence.
- update all [[PersistedInfo]] rows to be inactive and deletable
- remove | (defn- disable-persisting
[]
(let [id->db (m/index-by :id (t2/select Database))
enabled-dbs (filter (comp :persist-models-enabled :settings) (vals id->db))]
(log/info (tru "Disabling model persistence"))
(doseq [db enabled-dbs]
(t2/update! Database (u/the-id db)
{:settings (not-empty (dissoc (:settings db) :persist-models-enabled))}))
(task.persist-refresh/disable-persisting!))) |
/disable | (api/defendpoint POST
"Disable global setting to allow databases to persist models. This will remove all tasks to refresh tables, remove
that option from databases which might have it enabled, and delete all cached tables."
[]
(validation/check-has-application-permission :setting)
(when (public-settings/persisted-models-enabled)
(try (public-settings/persisted-models-enabled! false)
(disable-persisting)
(catch Exception e
;; re-enable so can continue to attempt to clean up
(public-settings/persisted-models-enabled! true)
(throw e))))
api/generic-204-no-content) |
(api/define-routes) | |
(ns metabase.api.premium-features (:require [compojure.core :refer [GET]] [metabase.api.common :as api] [metabase.public-settings.premium-features :as premium-features])) | |
/token/status | (api/defendpoint GET "Fetch info about the current Premium-Features premium features token including whether it is `valid`, a `trial` token, its `features`, when it is `valid-thru`, and the `status` of the account." [] (premium-features/fetch-token-status (api/check-404 (premium-features/premium-embedding-token)))) |
(api/define-routes api/+check-superuser) | |
Endpoints for previewing how Cards and Dashboards will look when embedding them.
These endpoints are basically identical in functionality to the ones in
| (ns metabase.api.preview-embed (:require [compojure.core :refer [GET]] [metabase.api.common :as api] [metabase.api.common.validation :as validation] [metabase.api.embed :as api.embed] [metabase.query-processor.pivot :as qp.pivot] [metabase.util.embed :as embed] [metabase.util.malli.schema :as ms])) |
(defn- check-and-unsign [token] (api/check-superuser) (validation/check-embedding-enabled) (embed/unsign token)) | |
/card/:token | (api/defendpoint GET
"Fetch a Card you're considering embedding by passing a JWT `token`."
[token]
{token ms/NonBlankString}
(let [unsigned-token (check-and-unsign token)]
(api.embed/card-for-unsigned-token unsigned-token
:embedding-params (embed/get-in-unsigned-token-or-throw unsigned-token [:_embedding_params])))) |
Embedding previews need to be limited in size to avoid performance issues (#20938). | (def ^:private max-results 2000) |
/card/:token/query | (api/defendpoint GET
"Fetch the query results for a Card you're considering embedding by passing a JWT `token`."
[token & query-params]
{token ms/NonBlankString}
(let [unsigned-token (check-and-unsign token)
card-id (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :question])]
(api.embed/run-query-for-card-with-params-async
:export-format :api
:card-id card-id
:token-params (embed/get-in-unsigned-token-or-throw unsigned-token [:params])
:embedding-params (embed/get-in-unsigned-token-or-throw unsigned-token [:_embedding_params])
:constraints {:max-results max-results}
:query-params query-params))) |
/dashboard/:token | (api/defendpoint GET
"Fetch a Dashboard you're considering embedding by passing a JWT `token`. "
[token]
{token ms/NonBlankString}
(let [unsigned-token (check-and-unsign token)]
(api.embed/dashboard-for-unsigned-token unsigned-token
:embedding-params (embed/get-in-unsigned-token-or-throw unsigned-token [:_embedding_params])))) |
/dashboard/:token/dashcard/:dashcard-id/card/:card-id | (api/defendpoint GET
"Fetch the results of running a Card belonging to a Dashboard you're considering embedding with JWT `token`."
[token dashcard-id card-id & query-params]
{token ms/NonBlankString
dashcard-id ms/PositiveInt
card-id ms/PositiveInt}
(let [unsigned-token (check-and-unsign token)
dashboard-id (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :dashboard])
embedding-params (embed/get-in-unsigned-token-or-throw unsigned-token [:_embedding_params])
token-params (embed/get-in-unsigned-token-or-throw unsigned-token [:params])]
(api.embed/dashcard-results-async
:export-format :api
:dashboard-id dashboard-id
:dashcard-id dashcard-id
:card-id card-id
:embedding-params embedding-params
:token-params token-params
:query-params query-params))) |
/pivot/card/:token/query | (api/defendpoint GET
"Fetch the query results for a Card you're considering embedding by passing a JWT `token`."
[token & query-params]
{token ms/NonBlankString}
(let [unsigned-token (check-and-unsign token)
card-id (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :question])]
(api.embed/run-query-for-card-with-params-async
:export-format :api
:card-id card-id
:token-params (embed/get-in-unsigned-token-or-throw unsigned-token [:params])
:embedding-params (embed/get-in-unsigned-token-or-throw unsigned-token [:_embedding_params])
:query-params query-params
:qp-runner qp.pivot/run-pivot-query))) |
/pivot/dashboard/:token/dashcard/:dashcard-id/card/:card-id | (api/defendpoint GET
"Fetch the results of running a Card belonging to a Dashboard you're considering embedding with JWT `token`."
[token dashcard-id card-id & query-params]
{token ms/NonBlankString
dashcard-id ms/PositiveInt
card-id ms/PositiveInt}
(let [unsigned-token (check-and-unsign token)
dashboard-id (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :dashboard])
embedding-params (embed/get-in-unsigned-token-or-throw unsigned-token [:_embedding_params])
token-params (embed/get-in-unsigned-token-or-throw unsigned-token [:params])]
(api.embed/dashcard-results-async
:export-format :api
:dashboard-id dashboard-id
:dashcard-id dashcard-id
:card-id card-id
:embedding-params embedding-params
:token-params token-params
:query-params query-params
:qp-runner qp.pivot/run-pivot-query))) |
(api/define-routes) | |
Metabase API endpoints for viewing publicly-accessible Cards and Dashboards. | (ns metabase.api.public (:require [cheshire.core :as json] [clojure.core.async :as a] [compojure.core :refer [GET]] [medley.core :as m] [metabase.actions :as actions] [metabase.actions.execution :as actions.execution] [metabase.analytics.snowplow :as snowplow] [metabase.api.card :as api.card] [metabase.api.common :as api] [metabase.api.common.validation :as validation] [metabase.api.dashboard :as api.dashboard] [metabase.api.dataset :as api.dataset] [metabase.api.field :as api.field] [metabase.async.util :as async.u] [metabase.db.util :as mdb.u] [metabase.events :as events] [metabase.mbql.util :as mbql.u] [metabase.models.action :as action] [metabase.models.card :as card :refer [Card]] [metabase.models.dashboard :refer [Dashboard]] [metabase.models.dimension :refer [Dimension]] [metabase.models.field :refer [Field]] [metabase.models.interface :as mi] [metabase.models.params :as params] [metabase.query-processor :as qp] [metabase.query-processor.card :as qp.card] [metabase.query-processor.dashboard :as qp.dashboard] [metabase.query-processor.error-type :as qp.error-type] [metabase.query-processor.middleware.constraints :as qp.constraints] [metabase.query-processor.pivot :as qp.pivot] [metabase.query-processor.streaming :as qp.streaming] [metabase.server.middleware.session :as mw.session] [metabase.util :as u] [metabase.util.embed :as embed] [metabase.util.i18n :refer [tru]] [metabase.util.malli.schema :as ms] [schema.core :as s] [throttle.core :as throttle] [toucan2.core :as t2]) (:import (clojure.lang ExceptionInfo))) |
(set! *warn-on-reflection* true) | |
(def ^:private ^:const ^Integer default-embed-max-height 800) (def ^:private ^:const ^Integer default-embed-max-width 1024) | |
-------------------------------------------------- Public Cards -------------------------------------------------- | |
Update On native queries parameters exists in 2 forms: - parameters - dataset_query.native.template-tags In most cases, these 2 are sync, meaning, if you have a template-tag, there will be a parameter. However, since card.parameters is a recently added feature, there may be instances where a template-tag is not present in the parameters. This function ensures that all template-tags are converted to parameters and added to card.parameters. | (defn combine-parameters-and-template-tags
[{:keys [parameters] :as card}]
(let [template-tag-parameters (card/template-tag-parameters card)
id->template-tags-parameter (m/index-by :id template-tag-parameters)
id->parameter (m/index-by :id parameters)]
(assoc card :parameters (vals (reduce-kv (fn [acc id parameter]
;; order importance: we want the info from `template-tag` to be merged last
(update acc id #(merge % parameter)))
id->parameter
id->template-tags-parameter))))) |
Remove everyting from public | (defn- remove-card-non-public-columns
[card]
(mi/instance
Card
(u/select-nested-keys card [:id :name :description :display :visualization_settings :parameters
[:dataset_query :type [:native :template-tags]]]))) |
Return a public Card matching key-value | (defn public-card
[& conditions]
(binding [params/*ignore-current-user-perms-and-return-all-field-values* true]
(-> (api/check-404 (apply t2/select-one [Card :id :dataset_query :description :display :name :parameters :visualization_settings]
:archived false, conditions))
remove-card-non-public-columns
combine-parameters-and-template-tags
(t2/hydrate :param_values :param_fields)))) |
(defn- card-with-uuid [uuid] (public-card :public_uuid uuid)) | |
/card/:uuid | (api/defendpoint GET
"Fetch a publicly-accessible Card an return query results as well as `:card` information. Does not require auth
credentials. Public sharing must be enabled."
[uuid]
{uuid ms/UUIDString}
(validation/check-public-sharing-enabled)
(card-with-uuid uuid)) |
Transform results to be suitable for a public endpoint | (defmulti ^:private transform-results
{:arglists '([results])}
:status) |
(defmethod transform-results :default [x] x) | |
(defmethod transform-results :completed
[results]
(u/select-nested-keys
results
[[:data :cols :rows :rows_truncated :insights :requested_timezone :results_timezone]
[:json_query :parameters]
:status])) | |
(defmethod transform-results :failed
[{error-type :error_type, :as results}]
;; if the query failed instead, unless the error type is specified and is EXPLICITLY allowed to be shown for embeds,
;; instead of returning anything about the query just return a generic error message
(merge
(select-keys results [:status :error :error_type])
(when-not (qp.error-type/show-in-embeds? error-type)
{:error (tru "An error occurred while running the query.")}))) | |
Reducer function for public data | (defn public-reducedf
[orig-reducedf]
(fn [final-metadata context]
(orig-reducedf (transform-results final-metadata) context))) |
Create the | (defn- run-query-for-card-with-id-async-run-fn
[qp-runner export-format]
(fn [query info]
(qp.streaming/streaming-response [{:keys [rff], {:keys [reducedf], :as context} :context}
export-format
(u/slugify (:card-name info))]
(let [context (assoc context :reducedf (public-reducedf reducedf))
in-chan (mw.session/as-admin
(qp-runner query info rff context))
out-chan (a/promise-chan (map transform-results))]
(async.u/promise-pipe in-chan out-chan)
out-chan)))) |
Run the query belonging to Card with | (defn run-query-for-card-with-id-async
[card-id export-format parameters & {:keys [qp-runner]
:or {qp-runner qp/process-query-and-save-execution!}
:as options}]
{:pre [(integer? card-id)]}
;; run this query with full superuser perms
;;
;; we actually need to bind the current user perms here twice, once so `card-api` will have the full perms when it
;; tries to do the `read-check`, and a second time for when the query is ran (async) so the QP middleware will have
;; the correct perms
(mw.session/as-admin
(m/mapply qp.card/run-query-for-card-async card-id export-format
:parameters parameters
:context :public-question
:run (run-query-for-card-with-id-async-run-fn qp-runner export-format)
options))) |
Run query for a public Card with UUID. If public sharing is not enabled, this throws an exception. Returns a
| (s/defn ^:private run-query-for-card-with-public-uuid-async
[uuid export-format parameters & options]
(validation/check-public-sharing-enabled)
(let [card-id (api/check-404 (t2/select-one-pk Card :public_uuid uuid, :archived false))]
(apply run-query-for-card-with-id-async card-id export-format parameters options))) |
/card/:uuid/query | (api/defendpoint GET
"Fetch a publicly-accessible Card an return query results as well as `:card` information. Does not require auth
credentials. Public sharing must be enabled."
[uuid parameters]
{uuid ms/UUIDString
parameters [:maybe ms/JSONString]}
(run-query-for-card-with-public-uuid-async uuid :api (json/parse-string parameters keyword))) |
/card/:uuid/query/:export-format | (api/defendpoint GET
"Fetch a publicly-accessible Card and return query results in the specified format. Does not require auth
credentials. Public sharing must be enabled."
[uuid export-format :as {{:keys [parameters]} :params}]
{uuid ms/UUIDString
export-format api.dataset/ExportFormat
parameters [:maybe ms/JSONString]}
(run-query-for-card-with-public-uuid-async
uuid
export-format
(json/parse-string parameters keyword)
:constraints nil
:middleware {:process-viz-settings? true
:js-int-to-string? false
:format-rows? false})) |
----------------------------------------------- Public Dashboards ------------------------------------------------ | |
The only keys for an action that should be visible to the general public. | (def ^:private action-public-keys
#{:name
:id
:database_id ;; needed to check if the database has actions enabled on the frontend
:visualization_settings
:parameters}) |
Returns a public version of | (defn- public-action
[action]
(let [hidden-parameter-ids (->> (get-in action [:visualization_settings :fields])
vals
(keep (fn [x]
(when (true? (:hidden x))
(:id x))))
set)]
(-> action
(update :parameters (fn [parameters]
(remove #(contains? hidden-parameter-ids (:id %)) parameters)))
(update-in [:visualization_settings :fields] (fn [fields]
(m/remove-keys hidden-parameter-ids fields)))
(select-keys action-public-keys)))) |
Return a public Dashboard matching key-value | (defn public-dashboard
[& conditions]
{:pre [(even? (count conditions))]}
(binding [params/*ignore-current-user-perms-and-return-all-field-values* true]
(-> (api/check-404 (apply t2/select-one [Dashboard :name :description :id :parameters :auto_apply_filters], :archived false, conditions))
(t2/hydrate [:dashcards :card :series :dashcard/action] :tabs :param_values :param_fields)
api.dashboard/add-query-average-durations
(update :dashcards (fn [dashcards]
(for [dashcard dashcards]
(-> (select-keys dashcard [:id :card :card_id :dashboard_id :series :col :row :size_x :dashboard_tab_id
:size_y :parameter_mappings :visualization_settings :action])
(update :card remove-card-non-public-columns)
(update :series (fn [series]
(for [series series]
(remove-card-non-public-columns series))))
(m/update-existing :action public-action)))))))) |
(defn- dashboard-with-uuid [uuid] (public-dashboard :public_uuid uuid)) | |
/dashboard/:uuid | (api/defendpoint GET
"Fetch a publicly-accessible Dashboard. Does not require auth credentials. Public sharing must be enabled."
[uuid]
{uuid ms/UUIDString}
(validation/check-public-sharing-enabled)
(u/prog1 (dashboard-with-uuid uuid)
(events/publish-event! :event/dashboard-read {:user-id api/*current-user-id*
:object <>}))) |
Return the results of running a query for Card with
Throws a 404 immediately if the Card isn't part of the Dashboard. Returns a TODO -- this should probably have a name like | (defn public-dashcard-results-async
{:arglists '([& {:keys [dashboard-id card-id dashcard-id export-format parameters] :as options}])}
[& {:keys [export-format parameters qp-runner]
:or {qp-runner qp/process-query-and-save-execution!
export-format :api}
:as options}]
(let [options (merge
{:context :public-dashboard
:constraints (qp.constraints/default-query-constraints)}
options
{:parameters (cond-> parameters
(string? parameters) (json/parse-string keyword))
:export-format export-format
:qp-runner qp-runner
:run (run-query-for-card-with-id-async-run-fn qp-runner export-format)})]
;; Run this query with full superuser perms. We don't want the various perms checks failing because there are no
;; current user perms; if this Dashcard is public you're by definition allowed to run it without a perms check
;; anyway
(mw.session/as-admin
(m/mapply qp.dashboard/run-query-for-dashcard-async options)))) |
/dashboard/:uuid/dashcard/:dashcard-id/card/:card-id | (api/defendpoint GET
"Fetch the results for a Card in a publicly-accessible Dashboard. Does not require auth credentials. Public
sharing must be enabled."
[uuid card-id dashcard-id parameters]
{uuid ms/UUIDString
dashcard-id ms/PositiveInt
card-id ms/PositiveInt
parameters [:maybe ms/JSONString]}
(validation/check-public-sharing-enabled)
(let [dashboard-id (api/check-404 (t2/select-one-pk Dashboard :public_uuid uuid, :archived false))]
(public-dashcard-results-async
:dashboard-id dashboard-id
:card-id card-id
:dashcard-id dashcard-id
:export-format :api
:parameters parameters))) |
/dashboard/:uuid/dashcard/:dashcard-id/execute | (api/defendpoint GET
"Fetches the values for filling in execution parameters. Pass PK parameters and values to select."
[uuid dashcard-id parameters]
{uuid ms/UUIDString
dashcard-id ms/PositiveInt
parameters ms/JSONString}
(validation/check-public-sharing-enabled)
(api/check-404 (t2/select-one-pk Dashboard :public_uuid uuid :archived false))
(actions.execution/fetch-values
(api/check-404 (action/dashcard->action dashcard-id))
(json/parse-string parameters))) |
(def ^:private dashcard-execution-throttle (throttle/make-throttler :dashcard-id :attempts-threshold 5000)) | |
/dashboard/:uuid/dashcard/:dashcard-id/execute | (api/defendpoint POST
"Execute the associated Action in the context of a `Dashboard` and `DashboardCard` that includes it.
`parameters` should be the mapped dashboard parameters with values."
[uuid dashcard-id :as {{:keys [parameters], :as _body} :body}]
{uuid ms/UUIDString
dashcard-id ms/PositiveInt
parameters [:maybe [:map-of :keyword :any]]}
(let [throttle-message (try
(throttle/check dashcard-execution-throttle dashcard-id)
nil
(catch ExceptionInfo e
(get-in (ex-data e) [:errors :dashcard-id])))
throttle-time (when throttle-message
(second (re-find #"You must wait ([0-9]+) seconds" throttle-message)))]
(if throttle-message
(cond-> {:status 429
:body throttle-message}
throttle-time (assoc :headers {"Retry-After" throttle-time}))
(do
(validation/check-public-sharing-enabled)
(let [dashboard-id (api/check-404 (t2/select-one-pk Dashboard :public_uuid uuid, :archived false))]
;; Run this query with full superuser perms. We don't want the various perms checks
;; failing because there are no current user perms; if this Dashcard is public
;; you're by definition allowed to run it without a perms check anyway
(binding [api/*current-user-permissions-set* (delay #{"/"})]
;; Undo middleware string->keyword coercion
(actions.execution/execute-dashcard! dashboard-id dashcard-id (update-keys parameters name)))))))) |
/oembed | (api/defendpoint GET
"oEmbed endpoint used to retreive embed code and metadata for a (public) Metabase URL."
[url format maxheight maxwidth]
;; the format param is not used by the API, but is required as part of the oEmbed spec: http://oembed.com/#section2
;; just return an error if `format` is specified and it's anything other than `json`.
{url ms/NonBlankString
format [:maybe [:enum "json"]]
maxheight [:maybe ms/IntString]
maxwidth [:maybe ms/IntString]}
(let [height (if maxheight (Integer/parseInt maxheight) default-embed-max-height)
width (if maxwidth (Integer/parseInt maxwidth) default-embed-max-width)]
{:version "1.0"
:type "rich"
:width width
:height height
:html (embed/iframe url width height)})) |
----------------------------------------------- Public Action ------------------------------------------------ | |
/action/:uuid | (api/defendpoint GET
"Fetch a publicly-accessible Action. Does not require auth credentials. Public sharing must be enabled."
[uuid]
{uuid ms/UUIDString}
(validation/check-public-sharing-enabled)
(let [action (api/check-404 (action/select-action :public_uuid uuid :archived false))]
(actions/check-actions-enabled! action)
(public-action action))) |
+----------------------------------------------------------------------------------------------------------------+ | FieldValues, Search, Remappings | +----------------------------------------------------------------------------------------------------------------+ | |
-------------------------------------------------- Field Values -------------------------------------------------- | |
Get the IDs of all Fields referenced by an MBQL | (defn- query->referenced-field-ids [query] (mbql.u/match (:query query) [:field id _] id)) |
Return a set of all Field IDs referenced by | (defn- card->referenced-field-ids
[card]
(set (concat (query->referenced-field-ids (:dataset_query card))
(params/card->template-tag-field-ids card)))) |
Check to make sure the query for Card with | (defn- check-field-is-referenced-by-card
[field-id card-id]
(let [card (api/check-404 (t2/select-one [Card :dataset_query] :id card-id))
referenced-field-ids (card->referenced-field-ids card)]
(api/check-404 (contains? referenced-field-ids field-id)))) |
Check whether a search Field is allowed to be used in conjunction with another Field. A search Field is allowed if any of the following conditions is true:
If none of these conditions are met, you are not allowed to use the search field in combination with the other field, and an 400 exception will be thrown. | (defn- check-search-field-is-allowed
[field-id search-field-id]
{:pre [(integer? field-id) (integer? search-field-id)]}
(api/check-400
(or (= field-id search-field-id)
(t2/exists? Dimension :field_id field-id, :human_readable_field_id search-field-id)
;; just do a couple small queries to figure this out, we could write a fancy query to join Field against itself
;; and do this in one but the extra code complexity isn't worth it IMO
(when-let [table-id (t2/select-one-fn :table_id Field :id field-id, :semantic_type (mdb.u/isa :type/PK))]
(t2/exists? Field :id search-field-id, :table_id table-id, :semantic_type (mdb.u/isa :type/Name)))))) |
Check that | (defn- check-field-is-referenced-by-dashboard
[field-id dashboard-id]
(let [dashboard (-> (t2/select-one Dashboard :id dashboard-id)
api/check-404
(t2/hydrate [:dashcards :card]))
param-field-ids (params/dashcards->param-field-ids (:dashcards dashboard))]
(api/check-404 (contains? param-field-ids field-id)))) |
Return the FieldValues for a Field with | (defn card-and-field-id->values [card-id field-id] (check-field-is-referenced-by-card field-id card-id) (api.field/field->values (t2/select-one Field :id field-id))) |
/card/:uuid/field/:field-id/values | (api/defendpoint GET
"Fetch FieldValues for a Field that is referenced by a public Card."
[uuid field-id]
{uuid ms/UUIDString
field-id ms/PositiveInt}
(validation/check-public-sharing-enabled)
(let [card-id (t2/select-one-pk Card :public_uuid uuid, :archived false)]
(card-and-field-id->values card-id field-id))) |
Return the FieldValues for a Field with | (defn dashboard-and-field-id->values [dashboard-id field-id] (check-field-is-referenced-by-dashboard field-id dashboard-id) (api.field/field->values (t2/select-one Field :id field-id))) |
/dashboard/:uuid/field/:field-id/values | (api/defendpoint GET
"Fetch FieldValues for a Field that is referenced by a Card in a public Dashboard."
[uuid field-id]
{uuid ms/UUIDString
field-id ms/PositiveInt}
(validation/check-public-sharing-enabled)
(let [dashboard-id (api/check-404 (t2/select-one-pk Dashboard :public_uuid uuid, :archived false))]
(dashboard-and-field-id->values dashboard-id field-id))) |
--------------------------------------------------- Searching ---------------------------------------------------- | |
Wrapper for | (defn search-card-fields [card-id field-id search-id value limit] (check-field-is-referenced-by-card field-id card-id) (check-search-field-is-allowed field-id search-id) (api.field/search-values (t2/select-one Field :id field-id) (t2/select-one Field :id search-id) value limit)) |
Wrapper for | (defn search-dashboard-fields [dashboard-id field-id search-id value limit] (check-field-is-referenced-by-dashboard field-id dashboard-id) (check-search-field-is-allowed field-id search-id) (api.field/search-values (t2/select-one Field :id field-id) (t2/select-one Field :id search-id) value limit)) |
/card/:uuid/field/:field-id/search/:search-field-id | (api/defendpoint GET
"Search for values of a Field that is referenced by a public Card."
[uuid field-id search-field-id value limit]
{uuid ms/UUIDString
field-id ms/PositiveInt
search-field-id ms/PositiveInt
value ms/NonBlankString
limit [:maybe ms/PositiveInt]}
(validation/check-public-sharing-enabled)
(let [card-id (t2/select-one-pk Card :public_uuid uuid, :archived false)]
(search-card-fields card-id field-id search-field-id value limit))) |
/dashboard/:uuid/field/:field-id/search/:search-field-id | (api/defendpoint GET
"Search for values of a Field that is referenced by a Card in a public Dashboard."
[uuid field-id search-field-id value limit]
{uuid ms/UUIDString
field-id ms/PositiveInt
search-field-id ms/PositiveInt
value ms/NonBlankString
limit [:maybe ms/PositiveInt]}
(validation/check-public-sharing-enabled)
(let [dashboard-id (api/check-404 (t2/select-one-pk Dashboard :public_uuid uuid, :archived false))]
(search-dashboard-fields dashboard-id field-id search-field-id value limit))) |
--------------------------------------------------- Remappings --------------------------------------------------- | |
(defn- field-remapped-values [field-id remapped-field-id, ^String value-str]
(let [field (api/check-404 (t2/select-one Field :id field-id))
remapped-field (api/check-404 (t2/select-one Field :id remapped-field-id))]
(check-search-field-is-allowed field-id remapped-field-id)
(api.field/remapped-value field remapped-field (api.field/parse-query-param-value-for-field field value-str)))) | |
Return the reampped Field values for a Field referenced by a Card. This explanation is almost useless, so see the
one in | (defn card-field-remapped-values [card-id field-id remapped-field-id, ^String value-str] (check-field-is-referenced-by-card field-id card-id) (field-remapped-values field-id remapped-field-id value-str)) |
Return the reampped Field values for a Field referenced by a Dashboard. This explanation is almost useless, so see
the one in | (defn dashboard-field-remapped-values [dashboard-id field-id remapped-field-id, ^String value-str] (check-field-is-referenced-by-dashboard field-id dashboard-id) (field-remapped-values field-id remapped-field-id value-str)) |
/card/:uuid/field/:field-id/remapping/:remapped-id | (api/defendpoint GET
"Fetch remapped Field values. This is the same as `GET /api/field/:id/remapping/:remapped-id`, but for use with public
Cards."
[uuid field-id remapped-id value]
{uuid ms/UUIDString
field-id ms/PositiveInt
remapped-id ms/PositiveInt
value ms/NonBlankString}
(validation/check-public-sharing-enabled)
(let [card-id (api/check-404 (t2/select-one-pk Card :public_uuid uuid, :archived false))]
(card-field-remapped-values card-id field-id remapped-id value))) |
/dashboard/:uuid/field/:field-id/remapping/:remapped-id | (api/defendpoint GET
"Fetch remapped Field values. This is the same as `GET /api/field/:id/remapping/:remapped-id`, but for use with public
Dashboards."
[uuid field-id remapped-id value]
{uuid ms/UUIDString
field-id ms/PositiveInt
remapped-id ms/PositiveInt
value ms/NonBlankString}
(validation/check-public-sharing-enabled)
(let [dashboard-id (t2/select-one-pk Dashboard :public_uuid uuid, :archived false)]
(dashboard-field-remapped-values dashboard-id field-id remapped-id value))) |
------------------------------------------------ Param Values ------------------------------------------------- | |
/card/:uuid/params/:param-key/values | (api/defendpoint GET
"Fetch values for a parameter on a public card."
[uuid param-key]
{uuid ms/UUIDString
param-key ms/NonBlankString}
(validation/check-public-sharing-enabled)
(let [card (t2/select-one Card :public_uuid uuid, :archived false)]
(mw.session/as-admin
(api.card/param-values card param-key)))) |
/card/:uuid/params/:param-key/search/:query | (api/defendpoint GET
"Fetch values for a parameter on a public card containing `query`."
[uuid param-key query]
{uuid ms/UUIDString
param-key ms/NonBlankString
query ms/NonBlankString}
(validation/check-public-sharing-enabled)
(let [card (t2/select-one Card :public_uuid uuid, :archived false)]
(mw.session/as-admin
(api.card/param-values card param-key query)))) |
/dashboard/:uuid/params/:param-key/values | (api/defendpoint GET
"Fetch filter values for dashboard parameter `param-key`."
[uuid param-key :as {constraint-param-key->value :query-params}]
{uuid ms/UUIDString
param-key ms/NonBlankString}
(let [dashboard (dashboard-with-uuid uuid)]
(mw.session/as-admin
(api.dashboard/param-values dashboard param-key constraint-param-key->value)))) |
/dashboard/:uuid/params/:param-key/search/:query | (api/defendpoint GET
"Fetch filter values for dashboard parameter `param-key`, containing specified `query`."
[uuid param-key query :as {constraint-param-key->value :query-params}]
{uuid ms/UUIDString
param-key ms/NonBlankString
query ms/NonBlankString}
(let [dashboard (dashboard-with-uuid uuid)]
(mw.session/as-admin
(api.dashboard/param-values dashboard param-key constraint-param-key->value query)))) |
----------------------------------------------------- Pivot Tables ----------------------------------------------- | |
/pivot/card/:uuid/query TODO -- why do these endpoints START with | (api/defendpoint GET
"Fetch a publicly-accessible Card an return query results as well as `:card` information. Does not require auth
credentials. Public sharing must be enabled."
[uuid parameters]
{uuid ms/UUIDString
parameters [:maybe ms/JSONString]}
(run-query-for-card-with-public-uuid-async uuid :api (json/parse-string parameters keyword) :qp-runner qp.pivot/run-pivot-query)) |
/pivot/dashboard/:uuid/dashcard/:dashcard-id/card/:card-id | (api/defendpoint GET
"Fetch the results for a Card in a publicly-accessible Dashboard. Does not require auth credentials. Public
sharing must be enabled."
[uuid card-id dashcard-id parameters]
{uuid ms/UUIDString
card-id ms/PositiveInt
dashcard-id ms/PositiveInt
parameters [:maybe ms/JSONString]}
(validation/check-public-sharing-enabled)
(let [dashboard-id (api/check-404 (t2/select-one-pk Dashboard :public_uuid uuid, :archived false))]
(public-dashcard-results-async
:dashboard-id dashboard-id
:card-id card-id
:dashcard-id dashcard-id
:export-format :api
:parameters parameters :qp-runner qp.pivot/run-pivot-query))) |
Rate limit at 1 action per second on a per action basis. The goal of rate limiting should be to prevent very obvious abuse, but it should be relatively lax so we don't annoy legitimate users. | (def ^:private action-execution-throttle (throttle/make-throttler :action-uuid :attempts-threshold 1 :initial-delay-ms 1000 :delay-exponent 1)) |
/action/:uuid/execute | (api/defendpoint POST
"Execute the Action.
`parameters` should be the mapped dashboard parameters with values."
[uuid :as {{:keys [parameters], :as _body} :body}]
{uuid ms/UUIDString
parameters [:maybe [:map-of :keyword any?]]}
(let [throttle-message (try
(throttle/check action-execution-throttle uuid)
nil
(catch ExceptionInfo e
(get-in (ex-data e) [:errors :action-uuid])))
throttle-time (when throttle-message
(second (re-find #"You must wait ([0-9]+) seconds" throttle-message)))]
(if throttle-message
(cond-> {:status 429
:body throttle-message}
throttle-time (assoc :headers {"Retry-After" throttle-time}))
(do
(validation/check-public-sharing-enabled)
;; Run this query with full superuser perms. We don't want the various perms checks
;; failing because there are no current user perms; if this Dashcard is public
;; you're by definition allowed to run it without a perms check anyway
(binding [api/*current-user-permissions-set* (delay #{"/"})]
(let [action (api/check-404 (action/select-action :public_uuid uuid :archived false))]
(snowplow/track-event! ::snowplow/action-executed api/*current-user-id* {:source :public_form
:type (:type action)
:action_id (:id action)})
;; Undo middleware string->keyword coercion
(actions.execution/execute-action! action (update-keys parameters name)))))))) |
----------------------------------------- Route Definitions & Complaints ----------------------------------------- | |
TODO - why don't we just make these routes have a bit of middleware that includes the
TODO - also a smart person would probably just parse the UUIDs automatically in middleware as appropriate for
| (api/define-routes) |
/api/pulse endpoints. | (ns metabase.api.pulse
(:require
[clojure.set :refer [difference]]
[compojure.core :refer [GET POST PUT]]
[hiccup.core :refer [html]]
[hiccup.page :refer [html5]]
[metabase.api.alert :as api.alert]
[metabase.api.common :as api]
[metabase.api.common.validation :as validation]
[metabase.config :as config]
[metabase.email :as email]
[metabase.events :as events]
[metabase.integrations.slack :as slack]
[metabase.models.card :refer [Card]]
[metabase.models.collection :as collection]
[metabase.models.dashboard :refer [Dashboard]]
[metabase.models.interface :as mi]
[metabase.models.pulse :as pulse :refer [Pulse]]
[metabase.models.pulse-channel
:as pulse-channel
:refer [channel-types PulseChannel]]
[metabase.models.pulse-channel-recipient :refer [PulseChannelRecipient]]
[metabase.plugins.classloader :as classloader]
[metabase.public-settings.premium-features :as premium-features]
[metabase.pulse]
[metabase.pulse.preview :as preview]
[metabase.pulse.render :as render]
[metabase.query-processor :as qp]
[metabase.query-processor.middleware.permissions :as qp.perms]
[metabase.util :as u]
[metabase.util.i18n :refer [tru]]
[metabase.util.malli.schema :as ms]
[metabase.util.urls :as urls]
[toucan2.core :as t2])
(:import
(java.io ByteArrayInputStream))) |
(set! *warn-on-reflection* true) | |
(when config/ee-available?
(classloader/require 'metabase-enterprise.sandbox.api.util
'metabase-enterprise.advanced-permissions.common)) | |
If the current user is sandboxed, remove all Metabase users from the | (defn- maybe-filter-pulses-recipients
[pulses]
(if (premium-features/sandboxed-or-impersonated-user?)
(for [pulse pulses]
(assoc pulse :channels
(for [channel (:channels pulse)]
(assoc channel :recipients
(filter (fn [recipient] (or (not (:id recipient))
(= (:id recipient) api/*current-user-id*)))
(:recipients channel))))))
pulses)) |
(defn- maybe-filter-pulse-recipients [pulse] (first (maybe-filter-pulses-recipients [pulse]))) | |
If the current user does not have collection read permissions for the pulse, but can still read the pulse due to being the creator or a recipient, we return it with some metadata removed. | (defn- maybe-strip-sensitive-metadata
[pulse]
(if (mi/current-user-has-full-permissions? :read pulse)
pulse
(-> (dissoc pulse :cards)
(update :channels
(fn [channels]
(map #(dissoc % :recipients) channels)))))) |
/ | (api/defendpoint GET
"Fetch all dashboard subscriptions. By default, returns only subscriptions for which the current user has write
permissions. For admins, this is all subscriptions; for non-admins, it is only subscriptions that they created.
If `dashboard_id` is specified, restricts results to subscriptions for that dashboard.
If `created_or_receive` is `true`, it specifically returns all subscriptions for which the current user
created *or* is a known recipient of. Note that this is a superset of the default items returned for non-admins,
and a subset of the default items returned for admins. This is used to power the /account/notifications page.
This may include subscriptions which the current user does not have collection permissions for, in which case
some sensitive metadata (the list of cards and recipients) is stripped out."
[archived dashboard_id creator_or_recipient]
{archived [:maybe ms/BooleanString]
dashboard_id [:maybe ms/PositiveInt]
creator_or_recipient [:maybe ms/BooleanString]}
(let [creator-or-recipient (Boolean/parseBoolean creator_or_recipient)
archived? (Boolean/parseBoolean archived)
pulses (->> (pulse/retrieve-pulses {:archived? archived?
:dashboard-id dashboard_id
:user-id (when creator-or-recipient api/*current-user-id*)})
(filter (if creator-or-recipient mi/can-read? mi/can-write?))
maybe-filter-pulses-recipients)
pulses (if creator-or-recipient
(map maybe-strip-sensitive-metadata pulses)
pulses)]
(t2/hydrate pulses :can_write))) |
Users can only create a pulse for | (defn check-card-read-permissions
[cards]
(doseq [card cards
:let [card-id (u/the-id card)]]
(assert (integer? card-id))
(api/read-check Card card-id))) |
/ | (api/defendpoint POST
"Create a new `Pulse`."
[:as {{:keys [name cards channels skip_if_empty collection_id collection_position dashboard_id parameters]} :body}]
{name ms/NonBlankString
cards [:+ pulse/CoercibleToCardRef]
channels [:+ :map]
skip_if_empty [:maybe :boolean]
collection_id [:maybe ms/PositiveInt]
collection_position [:maybe ms/PositiveInt]
dashboard_id [:maybe ms/PositiveInt]
parameters [:maybe [:sequential :map]]}
(validation/check-has-application-permission :subscription false)
;; make sure we are allowed to *read* all the Cards we want to put in this Pulse
(check-card-read-permissions cards)
;; if we're trying to create this Pulse inside a Collection, and it is not a dashboard subscription,
;; make sure we have write permissions for that collection
(when-not dashboard_id
(collection/check-write-perms-for-collection collection_id))
;; prohibit creating dashboard subs if the the user doesn't have at least read access for the dashboard
(when dashboard_id
(api/read-check Dashboard dashboard_id))
(let [pulse-data {:name name
:creator_id api/*current-user-id*
:skip_if_empty skip_if_empty
:collection_id collection_id
:collection_position collection_position
:dashboard_id dashboard_id
:parameters parameters}]
(t2/with-transaction [_conn]
;; Adding a new pulse at `collection_position` could cause other pulses in this collection to change position,
;; check that and fix it if needed
(api/maybe-reconcile-collection-position! pulse-data)
;; ok, now create the Pulse
(let [pulse (api/check-500
(pulse/create-pulse! (map pulse/card->ref cards) channels pulse-data))]
(events/publish-event! :event/pulse-create {:object pulse :user-id api/*current-user-id*})
pulse)))) |
/:id | (api/defendpoint GET
"Fetch `Pulse` with ID. If the user is a recipient of the Pulse but does not have read permissions for its collection,
we still return it but with some sensitive metadata removed."
[id]
{id ms/PositiveInt}
(api/let-404 [pulse (pulse/retrieve-pulse id)]
(api/check-403 (mi/can-read? pulse))
(-> pulse
maybe-filter-pulse-recipients
maybe-strip-sensitive-metadata
(t2/hydrate :can_write)))) |
Sandboxed users and users using connection impersonation can't read the full recipient list for a pulse, so we need to merge in existing recipients before writing the pulse updates to avoid them being deleted unintentionally. We only merge in recipients that are Metabase users, not raw email addresses, which these users can still view and modify. | (defn- maybe-add-recipients
[pulse-updates pulse-before-update]
(if (premium-features/sandboxed-or-impersonated-user?)
(let [recipients-to-add (filter
(fn [{id :id}] (and id (not= id api/*current-user-id*)))
(:recipients (api.alert/email-channel pulse-before-update)))]
(assoc pulse-updates :channels
(for [channel (:channels pulse-updates)]
(if (= "email" (:channel_type channel))
(assoc channel :recipients
(concat (:recipients channel) recipients-to-add))
channel))))
pulse-updates)) |
/:id | (api/defendpoint PUT
"Update a Pulse with `id`."
[id :as {{:keys [name cards channels skip_if_empty collection_id archived parameters], :as pulse-updates} :body}]
{id ms/PositiveInt
name [:maybe ms/NonBlankString]
cards [:maybe [:+ pulse/CoercibleToCardRef]]
channels [:maybe [:+ :map]]
skip_if_empty [:maybe :boolean]
collection_id [:maybe ms/PositiveInt]
archived [:maybe :boolean]
parameters [:maybe [:sequential ms/Map]]}
;; do various perms checks
(try
(validation/check-has-application-permission :monitoring)
(catch clojure.lang.ExceptionInfo _e
(validation/check-has-application-permission :subscription false)))
(let [pulse-before-update (api/write-check (pulse/retrieve-pulse id))]
(check-card-read-permissions cards)
(collection/check-allowed-to-change-collection pulse-before-update pulse-updates)
;; if advanced-permissions is enabled, only superuser or non-admin with subscription permission can
;; update pulse's recipients
(when (premium-features/enable-advanced-permissions?)
(let [to-add-recipients (difference (set (map :id (:recipients (api.alert/email-channel pulse-updates))))
(set (map :id (:recipients (api.alert/email-channel pulse-before-update)))))
current-user-has-application-permissions?
(and (premium-features/enable-advanced-permissions?)
(resolve 'metabase-enterprise.advanced-permissions.common/current-user-has-application-permissions?))
has-subscription-perms?
(and current-user-has-application-permissions?
(current-user-has-application-permissions? :subscription))]
(api/check (or api/*is-superuser?*
has-subscription-perms?
(empty? to-add-recipients))
[403 (tru "Non-admin users without subscription permissions are not allowed to add recipients")])))
(let [pulse-updates (maybe-add-recipients pulse-updates pulse-before-update)]
(t2/with-transaction [_conn]
;; If the collection or position changed with this update, we might need to fixup the old and/or new collection,
;; depending on what changed.
(api/maybe-reconcile-collection-position! pulse-before-update pulse-updates)
;; ok, now update the Pulse
(pulse/update-pulse!
(assoc (select-keys pulse-updates [:name :cards :channels :skip_if_empty :collection_id :collection_position
:archived :parameters])
:id id)))))
;; return updated Pulse
(pulse/retrieve-pulse id)) |
/form_input | (api/defendpoint GET
"Provides relevant configuration information and user choices for creating/updating Pulses."
[]
(validation/check-has-application-permission :subscription false)
(let [chan-types (-> channel-types
(assoc-in [:slack :configured] (slack/slack-configured?))
(assoc-in [:email :configured] (email/email-configured?)))]
{:channels (cond
(premium-features/sandboxed-or-impersonated-user?)
(dissoc chan-types :slack)
;; no Slack integration, so we are g2g
(not (get-in chan-types [:slack :configured]))
chan-types
;; if we have Slack enabled return cached channels and users
:else
(try
(future (slack/refresh-channels-and-usernames-when-needed!))
(assoc-in chan-types
[:slack :fields 0 :options]
(->> (slack/slack-cached-channels-and-usernames)
:channels
(map :display-name)))
(catch Throwable e
(assoc-in chan-types [:slack :error] (.getMessage e)))))})) |
(defn- pulse-card-query-results
{:arglists '([card])}
[{query :dataset_query, card-id :id}]
(binding [qp.perms/*card-id* card-id]
(qp/process-query-and-save-execution!
(assoc query
:async? false
:middleware {:process-viz-settings? true
:js-int-to-string? false})
{:executed-by api/*current-user-id*
:context :pulse
:card-id card-id}))) | |
/preview_card/:id | (api/defendpoint GET
"Get HTML rendering of a Card with `id`."
[id]
{id ms/PositiveInt}
(let [card (api/read-check Card id)
result (pulse-card-query-results card)]
{:status 200
:body (html5
[:html
[:body {:style "margin: 0;"}
(binding [render/*include-title* true
render/*include-buttons* true]
(render/render-pulse-card-for-display (metabase.pulse/defaulted-timezone card) card result))]])})) |
/preview_dashboard/:id | (api/defendpoint GET
"Get HTML rendering of a Dashboard with `id`.
This endpoint relies on a custom middleware defined in `metabase.pulse.preview/style-tag-nonce-middleware` to
allow the style tag to render properly, given our Content Security Policy setup. This middleware is attached to these
routes at the bottom of this namespace using `metabase.api.common/define-routes`."
[id]
{id ms/PositiveInt}
(api/read-check :model/Dashboard id)
{:status 200
:headers {"Content-Type" "text/html"}
:body (preview/style-tag-from-inline-styles
(html5
[:head
[:meta {:charset "utf-8"}]
[:link {:nonce "%NONCE%" ;; this will be str/replaced by 'style-tag-nonce-middleware
:rel "stylesheet"
:href "https://fonts.googleapis.com/css2?family=Lato:ital,wght@0,100;0,300;0,400;0,700;0,900;1,100;1,300;1,400;1,700;1,900&display=swap"}]]
[:body [:h2 (format "Backend Artifacts Preview for Dashboard %s" id)]
(preview/render-dashboard-to-html id)]))}) |
/previewcardinfo/:id | (api/defendpoint GET
"Get JSON object containing HTML rendering of a Card with `id` and other information."
[id]
{id ms/PositiveInt}
(let [card (api/read-check Card id)
result (pulse-card-query-results card)
data (:data result)
card-type (render/detect-pulse-chart-type card nil data)
card-html (html (binding [render/*include-title* true]
(render/render-pulse-card-for-display (metabase.pulse/defaulted-timezone card) card result)))]
{:id id
:pulse_card_type card-type
:pulse_card_html card-html
:pulse_card_name (:name card)
:pulse_card_url (urls/card-url (:id card))
:row_count (:row_count result)
:col_count (count (:cols (:data result)))})) |
(def ^:private preview-card-width 400) | |
/previewcardpng/:id | (api/defendpoint GET
"Get PNG rendering of a Card with `id`."
[id]
{id ms/PositiveInt}
(let [card (api/read-check Card id)
result (pulse-card-query-results card)
ba (binding [render/*include-title* true]
(render/render-pulse-card-to-png (metabase.pulse/defaulted-timezone card) card result preview-card-width))]
{:status 200, :headers {"Content-Type" "image/png"}, :body (ByteArrayInputStream. ba)})) |
/test | (api/defendpoint POST
"Test send an unsaved pulse."
[:as {{:keys [name cards channels skip_if_empty collection_id collection_position dashboard_id] :as body} :body}]
{name ms/NonBlankString
cards [:+ pulse/CoercibleToCardRef]
channels [:+ :map]
skip_if_empty [:maybe :boolean]
collection_id [:maybe ms/PositiveInt]
collection_position [:maybe ms/PositiveInt]
dashboard_id [:maybe ms/PositiveInt]}
(check-card-read-permissions cards)
;; make sure any email addresses that are specified are allowed before sending the test Pulse.
(doseq [channel channels]
(pulse-channel/validate-email-domains channel))
(metabase.pulse/send-pulse! (assoc body :creator_id api/*current-user-id*))
{:ok true}) |
/:id/subscription | (api/defendpoint DELETE
"For users to unsubscribe themselves from a pulse subscription."
[id]
{id ms/PositiveInt}
(api/let-404 [pulse-id (t2/select-one-pk Pulse :id id)
pc-id (t2/select-one-pk PulseChannel :pulse_id pulse-id :channel_type "email")
pcr-id (t2/select-one-pk PulseChannelRecipient :pulse_channel_id pc-id :user_id api/*current-user-id*)]
(t2/delete! PulseChannelRecipient :id pcr-id))
api/generic-204-no-content) |
(def ^:private style-nonce-middleware (partial preview/style-tag-nonce-middleware "/api/pulse/preview_dashboard")) | |
(api/define-routes style-nonce-middleware) | |
(ns metabase.api.revision (:require [compojure.core :refer [GET POST]] [metabase.api.card :as api.card] [metabase.api.common :as api] [metabase.models.card :refer [Card]] [metabase.models.dashboard :refer [Dashboard]] [metabase.models.revision :as revision :refer [Revision]] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) | |
Schema for a valid revisionable entity name. | (def ^:private Entity [:enum "card" "dashboard"]) |
(defn- model-and-instance [entity-name id]
(case entity-name
"card" [Card (t2/select-one Card :id id)]
"dashboard" [Dashboard (t2/select-one Dashboard :id id)])) | |
/ | (api/defendpoint GET
"Get revisions of an object."
[entity id]
{id ms/PositiveInt
entity Entity}
(let [[model instance] (model-and-instance entity id)]
(when (api/read-check instance)
(revision/revisions+details model id)))) |
/revert | (api/defendpoint POST
"Revert an object to a prior revision."
[:as {{:keys [entity id revision_id]} :body}]
{id ms/PositiveInt
entity Entity
revision_id ms/PositiveInt}
(let [[model instance] (model-and-instance entity id)
_ (api/write-check instance)
revision (api/check-404 (t2/select-one Revision :model (name model), :model_id id, :id revision_id))]
;; if reverting a Card, make sure we have *data* permissions to run the query we're reverting to
(when (= model Card)
(api.card/check-data-permissions-for-query (get-in revision [:object :dataset_query])))
;; ok, we're g2g
(revision/revert!
{:entity model
:id id
:user-id api/*current-user-id*
:revision-id revision_id}))) |
(api/define-routes) | |
(ns metabase.api.routes
(:require
[compojure.core :refer [context defroutes]]
[compojure.route :as route]
[metabase.api.action :as api.action]
[metabase.api.activity :as api.activity]
[metabase.api.alert :as api.alert]
[metabase.api.api-key :as api.api-key]
[metabase.api.automagic-dashboards :as api.magic]
[metabase.api.bookmark :as api.bookmark]
[metabase.api.card :as api.card]
[metabase.api.collection :as api.collection]
[metabase.api.dashboard :as api.dashboard]
[metabase.api.database :as api.database]
[metabase.api.dataset :as api.dataset]
[metabase.api.email :as api.email]
[metabase.api.embed :as api.embed]
[metabase.api.field :as api.field]
[metabase.api.geojson :as api.geojson]
[metabase.api.google :as api.google]
[metabase.api.ldap :as api.ldap]
[metabase.api.login-history :as api.login-history]
[metabase.api.metabot :as api.metabot]
[metabase.api.metric :as api.metric]
[metabase.api.model-index :as api.model-index]
[metabase.api.native-query-snippet :as api.native-query-snippet]
[metabase.api.notify :as api.notify]
[metabase.api.permissions :as api.permissions]
[metabase.api.persist :as api.persist]
[metabase.api.premium-features :as api.premium-features]
[metabase.api.preview-embed :as api.preview-embed]
[metabase.api.public :as api.public]
[metabase.api.pulse :as api.pulse]
[metabase.api.revision :as api.revision]
[metabase.api.routes.common
:refer [+static-apikey +auth +message-only-exceptions +public-exceptions]]
[metabase.api.search :as api.search]
[metabase.api.segment :as api.segment]
[metabase.api.session :as api.session]
[metabase.api.setting :as api.setting]
[metabase.api.setup :as api.setup]
[metabase.api.slack :as api.slack]
[metabase.api.table :as api.table]
[metabase.api.task :as api.task]
[metabase.api.testing :as api.testing]
[metabase.api.tiles :as api.tiles]
[metabase.api.timeline :as api.timeline]
[metabase.api.timeline-event :as api.timeline-event]
[metabase.api.transform :as api.transform]
[metabase.api.user :as api.user]
[metabase.api.util :as api.util]
[metabase.config :as config]
[metabase.plugins.classloader :as classloader]
[metabase.util.i18n :refer [deferred-tru]])) | |
(when config/ee-available? (classloader/require 'metabase-enterprise.api.routes)) | |
EE routes defined in [[metabase-enterprise.api.routes/routes]] always get the first chance to handle a request, if
they exist. If they don't exist, this handler returns | (def ^:private ^{:arglists '([request respond raise])} ee-routes
;; resolve the var for every request so we pick up any changes to it in interactive development
(if-let [ee-handler-var (resolve 'metabase-enterprise.api.routes/routes)]
(fn [request respond raise]
((var-get ee-handler-var) request respond raise))
(fn [_request respond _raise]
(respond nil)))) |
Ring routes for API endpoints. | (defroutes routes
ee-routes
(context "/action" [] (+auth api.action/routes))
(context "/activity" [] (+auth api.activity/routes))
(context "/alert" [] (+auth api.alert/routes))
(context "/automagic-dashboards" [] (+auth api.magic/routes))
(context "/card" [] (+auth api.card/routes))
(context "/bookmark" [] (+auth api.bookmark/routes))
(context "/collection" [] (+auth api.collection/routes))
(context "/dashboard" [] (+auth api.dashboard/routes))
(context "/database" [] (+auth api.database/routes))
(context "/dataset" [] (+auth api.dataset/routes))
(context "/email" [] (+auth api.email/routes))
(context "/embed" [] (+message-only-exceptions api.embed/routes))
(context "/field" [] (+auth api.field/routes))
(context "/geojson" [] api.geojson/routes)
(context "/google" [] (+auth api.google/routes))
(context "/ldap" [] (+auth api.ldap/routes))
(context "/login-history" [] (+auth api.login-history/routes))
(context "/premium-features" [] (+auth api.premium-features/routes))
(context "/metabot" [] (+auth api.metabot/routes))
(context "/metric" [] (+auth api.metric/routes))
(context "/model-index" [] (+auth api.model-index/routes))
(context "/native-query-snippet" [] (+auth api.native-query-snippet/routes))
(context "/notify" [] (+static-apikey api.notify/routes))
(context "/permissions" [] (+auth api.permissions/routes))
(context "/persist" [] (+auth api.persist/routes))
(context "/preview_embed" [] (+auth api.preview-embed/routes))
(context "/public" [] (+public-exceptions api.public/routes))
(context "/pulse" [] (+auth api.pulse/routes))
(context "/revision" [] (+auth api.revision/routes))
(context "/search" [] (+auth api.search/routes))
(context "/segment" [] (+auth api.segment/routes))
(context "/session" [] api.session/routes)
(context "/setting" [] (+auth api.setting/routes))
(context "/setup" [] api.setup/routes)
(context "/slack" [] (+auth api.slack/routes))
(context "/table" [] (+auth api.table/routes))
(context "/task" [] (+auth api.task/routes))
(context "/testing" [] (if (or (not config/is-prod?)
(config/config-bool :mb-enable-test-endpoints))
api.testing/routes
(fn [_ respond _] (respond nil))))
(context "/tiles" [] (+auth api.tiles/routes))
(context "/timeline" [] (+auth api.timeline/routes))
(context "/timeline-event" [] (+auth api.timeline-event/routes))
(context "/transform" [] (+auth api.transform/routes))
(context "/user" [] (+auth api.user/routes))
(context "/api-key" [] (+auth api.api-key/routes))
(context "/util" [] api.util/routes)
(route/not-found (constantly {:status 404, :body (deferred-tru "API endpoint does not exist.")}))) |
Shared helpers used by [[metabase.api.routes/routes]] as well as premium-only routes like [[metabase-enterprise.sandbox.api.routes/routes]]. | (ns metabase.api.routes.common (:require [metabase.server.middleware.auth :as mw.auth] [metabase.server.middleware.exceptions :as mw.exceptions])) |
Wrap | (def +public-exceptions #'mw.exceptions/public-exceptions) |
Wrap | (def +message-only-exceptions #'mw.exceptions/message-only-exceptions) |
Wrap | (def +static-apikey #'mw.auth/enforce-static-api-key) |
Wrap | (def +auth #'mw.auth/enforce-authentication) |
(ns metabase.api.search (:require [cheshire.core :as json] [compojure.core :refer [GET]] [honey.sql.helpers :as sql.helpers] [medley.core :as m] [metabase.analytics.snowplow :as snowplow] [metabase.api.common :as api] [metabase.db :as mdb] [metabase.db.query :as mdb.query] [metabase.models.collection :as collection] [metabase.models.interface :as mi] [metabase.models.permissions :as perms] [metabase.public-settings.premium-features :as premium-features] [metabase.search.config :as search.config :refer [SearchableModel SearchContext]] [metabase.search.filter :as search.filter] [metabase.search.scoring :as scoring] [metabase.search.util :as search.util] [metabase.server.middleware.offset-paging :as mw.offset-paging] [metabase.util :as u] [metabase.util.honey-sql-2 :as h2x] [metabase.util.i18n :refer [deferred-tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2] [toucan2.instance :as t2.instance] [toucan2.realize :as t2.realize])) | |
(set! *warn-on-reflection* true) | |
(def ^:private HoneySQLColumn [:or :keyword [:tuple :any :keyword]]) | |
+----------------------------------------------------------------------------------------------------------------+ | Shared Query Logic | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn ^:private ->column-alias :- keyword?
"Returns the column name. If the column is aliased, i.e. [`:original_name` `:aliased_name`], return the aliased
column name"
[column-or-aliased :- HoneySQLColumn]
(if (sequential? column-or-aliased)
(second column-or-aliased)
column-or-aliased)) | |
(mu/defn ^:private canonical-columns :- [:sequential HoneySQLColumn]
"Returns a seq of canonicalized list of columns for the search query with the given `model` Will return column names
prefixed with the `model` name so that it can be used in criteria. Projects a `nil` for columns the `model` doesn't
have and doesn't modify aliases."
[model :- SearchableModel, col-alias->honeysql-clause :- [:map-of :keyword HoneySQLColumn]]
(for [[search-col col-type] search.config/all-search-columns
:let [maybe-aliased-col (get col-alias->honeysql-clause search-col)]]
(cond
(= search-col :model)
[(h2x/literal model) :model]
;; This is an aliased column, no need to include the table alias
(sequential? maybe-aliased-col)
maybe-aliased-col
;; This is a column reference, need to add the table alias to the column
maybe-aliased-col
(search.config/column-with-model-alias model maybe-aliased-col)
;; This entity is missing the column, project a null for that column value. For Postgres and H2, cast it to the
;; correct type, e.g.
;;
;; SELECT cast(NULL AS integer)
;;
;; For MySQL, this is not needed.
:else
[(when-not (= (mdb/db-type) :mysql)
[:cast nil col-type])
search-col]))) | |
(mu/defn ^:private select-clause-for-model :- [:sequential HoneySQLColumn]
"The search query uses a `union-all` which requires that there be the same number of columns in each of the segments
of the query. This function will take the columns for `model` and will inject constant `nil` values for any column
missing from `entity-columns` but found in `search.config/all-search-columns`."
[model :- SearchableModel]
(let [entity-columns (search.config/columns-for-model model)
column-alias->honeysql-clause (m/index-by ->column-alias entity-columns)
cols-or-nils (canonical-columns model column-alias->honeysql-clause)]
cols-or-nils)) | |
(mu/defn ^:private from-clause-for-model :- [:tuple [:tuple :keyword :keyword]]
[model :- SearchableModel]
(let [{:keys [db-model alias]} (get search.config/model-to-db-model model)]
[[(t2/table-name db-model) alias]])) | |
(mu/defn ^:private base-query-for-model :- [:map {:closed true}
[:select :any]
[:from :any]
[:where :any]
[:join {:optional true} :any]
[:left-join {:optional true} :any]]
"Create a HoneySQL query map with `:select`, `:from`, and `:where` clauses for `model`, suitable for the `UNION ALL`
used in search."
[model :- SearchableModel context :- SearchContext]
(-> {:select (select-clause-for-model model)
:from (from-clause-for-model model)}
(search.filter/build-filters model context))) | |
Add a | (mu/defn add-collection-join-and-where-clauses
[honeysql-query :- ms/Map
collection-id-column :- keyword?
{:keys [current-user-perms
filter-items-in-personal-collection]} :- SearchContext]
(let [visible-collections (collection/permissions-set->visible-collection-ids current-user-perms)
collection-filter-clause (collection/visible-collection-ids->honeysql-filter-clause
collection-id-column
visible-collections)]
(cond-> honeysql-query
true
(sql.helpers/where collection-filter-clause (perms/audit-namespace-clause :collection.namespace nil))
;; add a JOIN against Collection *unless* the source table is already Collection
(not= collection-id-column :collection.id)
(sql.helpers/left-join [:collection :collection]
[:= collection-id-column :collection.id])
(some? filter-items-in-personal-collection)
(sql.helpers/where
(case filter-items-in-personal-collection
"only"
(concat [:or]
;; sub personal collections
(for [id (t2/select-pks-set :model/Collection :personal_owner_id [:not= nil])]
[:like :collection.location (format "/%d/%%" id)])
;; top level personal collections
[[:and
[:= :collection.location "/"]
[:not= :collection.personal_owner_id nil]]])
"exclude"
(conj [:or]
(into
[:and [:= :collection.personal_owner_id nil]]
(for [id (t2/select-pks-set :model/Collection :personal_owner_id [:not= nil])]
[:not-like :collection.location (format "/%d/%%" id)]))
[:= collection-id-column nil])))))) |
Add a WHERE clause to only return tables with the given DB id. Used in data picker for joins because we can't join across DB's. | (mu/defn ^:private add-table-db-id-clause
[query :- ms/Map id :- [:maybe ms/PositiveInt]]
(if (some? id)
(sql.helpers/where query [:= id :db_id])
query)) |
Add a WHERE clause to only return cards with the given DB id. Used in data picker for joins because we can't join across DB's. | (mu/defn ^:private add-card-db-id-clause
[query :- ms/Map id :- [:maybe ms/PositiveInt]]
(if (some? id)
(sql.helpers/where query [:= id :database_id])
query)) |
(mu/defn ^:private replace-select :- :map
"Replace a select from query that has alias is `target-alias` with [`with` `target-alias`] column, throw an error if
can't find the target select.
This works with the assumption that `query` contains a list of select from [[select-clause-for-model]],
and some of them are dummy column casted to the correct type.
This function then will replace the dummy column with alias is `target-alias` with the `with` column."
[query :- :map
target-alias :- :keyword
with :- :keyword]
(let [selects (:select query)
idx (first (keep-indexed (fn [index item]
(when (and (coll? item)
(= (last item) target-alias))
index))
selects))
with-select [with target-alias]]
(if (some? idx)
(assoc query :select (m/replace-nth idx with-select selects))
(throw (ex-info "Failed to replace selector" {:status-code 400
:target-alias target-alias
:with with}))))) | |
(mu/defn ^:private with-last-editing-info :- :map
[query :- :map
model :- [:enum "card" "dataset" "dashboard" "metric"]]
(-> query
(replace-select :last_editor_id :r.user_id)
(replace-select :last_edited_at :r.timestamp)
(sql.helpers/left-join [:revision :r]
[:and [:= :r.model_id (search.config/column-with-model-alias model :id)]
[:= :r.most_recent true]
[:= :r.model (search.config/search-model->revision-model model)]]))) | |
(mu/defn ^:private with-moderated-status :- :map
[query :- :map
model :- [:enum "card" "dataset"]]
(-> query
(replace-select :moderated_status :mr.status)
(sql.helpers/left-join [:moderation_review :mr]
[:and
[:= :mr.moderated_item_type "card"]
[:= :mr.moderated_item_id (search.config/column-with-model-alias model :id)]
[:= :mr.most_recent true]]))) | |
+----------------------------------------------------------------------------------------------------------------+ | Search Queries for each Toucan Model | +----------------------------------------------------------------------------------------------------------------+ | |
(defmulti ^:private search-query-for-model
{:arglists '([model search-context])}
(fn [model _] model)) | |
(mu/defn ^:private shared-card-impl
[model :- [:enum "card" "dataset"]
search-ctx :- SearchContext]
(-> (base-query-for-model "card" search-ctx)
(update :where (fn [where] [:and [:= :card.dataset (= "dataset" model)] where]))
(sql.helpers/left-join [:card_bookmark :bookmark]
[:and
[:= :bookmark.card_id :card.id]
[:= :bookmark.user_id api/*current-user-id*]])
(add-collection-join-and-where-clauses :card.collection_id search-ctx)
(add-card-db-id-clause (:table-db-id search-ctx))
(with-last-editing-info model)
(with-moderated-status model))) | |
(defmethod search-query-for-model "action"
[model search-ctx]
(-> (base-query-for-model model search-ctx)
(sql.helpers/left-join [:report_card :model]
[:= :model.id :action.model_id])
(sql.helpers/left-join :query_action
[:= :query_action.action_id :action.id])
(add-collection-join-and-where-clauses :model.collection_id search-ctx))) | |
(defmethod search-query-for-model "card" [_model search-ctx] (shared-card-impl "card" search-ctx)) | |
(defmethod search-query-for-model "dataset"
[_model search-ctx]
(-> (shared-card-impl "dataset" search-ctx)
(update :select (fn [columns]
(cons [(h2x/literal "dataset") :model] (rest columns)))))) | |
(defmethod search-query-for-model "collection"
[_model search-ctx]
(-> (base-query-for-model "collection" search-ctx)
(sql.helpers/left-join [:collection_bookmark :bookmark]
[:and
[:= :bookmark.collection_id :collection.id]
[:= :bookmark.user_id api/*current-user-id*]])
(add-collection-join-and-where-clauses :collection.id search-ctx))) | |
(defmethod search-query-for-model "database" [model search-ctx] (base-query-for-model model search-ctx)) | |
(defmethod search-query-for-model "dashboard"
[model search-ctx]
(-> (base-query-for-model model search-ctx)
(sql.helpers/left-join [:dashboard_bookmark :bookmark]
[:and
[:= :bookmark.dashboard_id :dashboard.id]
[:= :bookmark.user_id api/*current-user-id*]])
(add-collection-join-and-where-clauses :dashboard.collection_id search-ctx)
(with-last-editing-info model))) | |
(defmethod search-query-for-model "metric"
[model search-ctx]
(-> (base-query-for-model model search-ctx)
(sql.helpers/left-join [:metabase_table :table] [:= :metric.table_id :table.id])
(with-last-editing-info model))) | |
(defn- add-model-index-permissions-clause
[query current-user-perms]
(let [build-path (fn [x y z] (h2x/concat (h2x/literal x) y (h2x/literal z)))
has-perm-clause (fn [x y z] [:in (build-path x y z) current-user-perms])]
(if (contains? current-user-perms "/")
query
;; Select indexed rows if user has /db/:id/ OR (/db/:id/native/ AND /db/:id/schema/) - aka full access to the database
;; in at least one group. (Access to only a subset of tables isn't enough, since models can be based on native
;; queries.)
;; AND
;; User has /collection/:id/ or /collection/:id/read/ for the collection the model is in.
(let [data-perm-clause
[:or
(has-perm-clause "/db/" :model.database_id "/")
[:and
(has-perm-clause "/db/" :model.database_id "/native/")
(has-perm-clause "/db/" :model.database_id "/schema/")]]
has-root-access?
(or (contains? current-user-perms "/collection/root/")
(contains? current-user-perms "/collection/root/read/"))
collection-perm-clause
[:or
(when has-root-access? [:= :model.collection_id nil])
[:and
[:not= :model.collection_id nil]
[:or
(has-perm-clause "/collection/" :model.collection_id "/")
(has-perm-clause "/collection/" :model.collection_id "/read/")]]]]
(sql.helpers/where
query
[:and data-perm-clause collection-perm-clause]))))) | |
(defmethod search-query-for-model "indexed-entity"
[model {:keys [current-user-perms] :as search-ctx}]
(-> (base-query-for-model model search-ctx)
(sql.helpers/left-join [:model_index :model-index]
[:= :model-index.id :model-index-value.model_index_id])
(sql.helpers/left-join [:report_card :model] [:= :model-index.model_id :model.id])
(sql.helpers/left-join [:collection :collection] [:= :model.collection_id :collection.id])
(add-model-index-permissions-clause current-user-perms))) | |
(defmethod search-query-for-model "segment"
[model search-ctx]
(-> (base-query-for-model model search-ctx)
(sql.helpers/left-join [:metabase_table :table] [:= :segment.table_id :table.id]))) | |
(defmethod search-query-for-model "table"
[model {:keys [current-user-perms table-db-id], :as search-ctx}]
(when (seq current-user-perms)
(let [base-query (base-query-for-model model search-ctx)]
(add-table-db-id-clause
(if (contains? current-user-perms "/")
base-query
(let [data-perms (filter #(re-find #"^/db/*" %) current-user-perms)]
{:select (:select base-query)
:from [[(merge
base-query
{:select [:id :schema :db_id :name :description :display_name :created_at :updated_at :initial_sync_status
[(h2x/concat (h2x/literal "/db/")
:db_id
(h2x/literal "/schema/")
[:case
[:not= :schema nil] :schema
:else (h2x/literal "")]
(h2x/literal "/table/") :id
(h2x/literal "/read/"))
:path]]})
:table]]
:where (if (seq data-perms)
(into [:or] (for [path data-perms]
[:like :path (str path "%")]))
[:inline [:= 0 1]])}))
table-db-id)))) | |
CASE expression that lets the results be ordered by whether they're an exact (non-fuzzy) match or not | (defn order-clause
[query]
(let [match (search.util/wildcard-match (search.util/normalize query))
columns-to-search (->> search.config/all-search-columns
(filter (fn [[_k v]] (= v :text)))
(map first)
(remove #{:collection_authority_level :moderated_status
:initial_sync_status :pk_ref}))
case-clauses (as-> columns-to-search <>
(map (fn [col] [:like [:lower col] match]) <>)
(interleave <> (repeat [:inline 0]))
(concat <> [:else [:inline 1]]))]
[(into [:case] case-clauses)])) |
(defmulti ^:private check-permissions-for-model
{:arglists '([archived? search-result])}
(fn [_ search-result] ((comp keyword :model) search-result))) | |
(defmethod check-permissions-for-model :default
[archived? instance]
(if archived?
(mi/can-write? instance)
;; We filter what we can (ie. everything that is in a collection) out already when querying
true)) | |
(defmethod check-permissions-for-model :metric
[archived? instance]
(if archived?
(mi/can-write? instance)
(mi/can-read? instance))) | |
(defmethod check-permissions-for-model :segment
[archived? instance]
(if archived?
(mi/can-write? instance)
(mi/can-read? instance))) | |
(defmethod check-permissions-for-model :database
[archived? instance]
(if archived?
(mi/can-write? instance)
(mi/can-read? instance))) | |
(mu/defn query-model-set :- [:set SearchableModel]
"Queries all models with respect to query for one result to see if we get a result or not"
[search-ctx :- SearchContext]
(let [model-queries (for [model (search.filter/search-context->applicable-models
(assoc search-ctx :models search.config/all-models))]
{:nest (sql.helpers/limit (search-query-for-model model search-ctx) 1)})
query (when (pos-int? (count model-queries))
{:select [:*]
:from [[{:union-all model-queries} :dummy_alias]]})]
(set (some->> query
mdb.query/query
(map :model)
set)))) | |
Postgres 9 is not happy with the type munging it needs to do to make the union-all degenerate down to trivial case of one model without errors. Therefore we degenerate it down for it | (mu/defn ^:private full-search-query
[search-ctx :- SearchContext]
(let [models (:models search-ctx)
order-clause [((fnil order-clause "") (:search-string search-ctx))]]
(cond
(= (count models) 0)
{:select [nil]}
(= (count models) 1)
(search-query-for-model (first models) search-ctx)
:else
{:select [:*]
:from [[{:union-all (vec (for [model models
:let [query (search-query-for-model model search-ctx)]
:when (seq query)]
query))} :alias_is_required_by_sql_but_not_needed_here]]
:order-by order-clause}))) |
Hydrate common-name for lasteditedby and created_by from result. | (defn- hydrate-user-metadata
[results]
(let [user-ids (set (flatten (for [result results]
(remove nil? ((juxt :last_editor_id :creator_id) result)))))
user-id->common-name (if (pos? (count user-ids))
(t2/select-pk->fn :common_name [:model/User :id :first_name :last_name :email] :id [:in user-ids])
{})]
(mapv (fn [{:keys [creator_id last_editor_id] :as result}]
(assoc result
:creator_common_name (get user-id->common-name creator_id)
:last_editor_common_name (get user-id->common-name last_editor_id)))
results))) |
Builds a search query that includes all the searchable entities and runs it | (mu/defn ^:private search
[search-ctx :- SearchContext]
(let [search-query (full-search-query search-ctx)
_ (log/tracef "Searching with query:\n%s\n%s"
(u/pprint-to-str search-query)
(mdb.query/format-sql (first (mdb.query/compile search-query))))
to-toucan-instance (fn [row]
(let [model (-> row :model search.config/model-to-db-model :db-model)]
(t2.instance/instance model row)))
reducible-results (mdb.query/reducible-query search-query :max-rows search.config/*db-max-results*)
xf (comp
(map t2.realize/realize)
(map to-toucan-instance)
(filter (partial check-permissions-for-model (:archived? search-ctx)))
;; MySQL returns `:bookmark` and `:archived` as `1` or `0` so convert those to boolean as
;; needed
(map #(update % :bookmark api/bit->boolean))
(map #(update % :archived api/bit->boolean))
(map #(update % :pk_ref json/parse-string))
(map (partial scoring/score-and-result (:search-string search-ctx)))
(filter #(pos? (:score %))))
total-results (hydrate-user-metadata (scoring/top-results reducible-results search.config/max-filtered-results xf))]
;; We get to do this slicing and dicing with the result data because
;; the pagination of search is for UI improvement, not for performance.
;; We intend for the cardinality of the search results to be below the default max before this slicing occurs
{:total (count total-results)
:data (cond->> total-results
(some? (:offset-int search-ctx)) (drop (:offset-int search-ctx))
(some? (:limit-int search-ctx)) (take (:limit-int search-ctx)))
:available_models (query-model-set search-ctx)
:limit (:limit-int search-ctx)
:offset (:offset-int search-ctx)
:table_db_id (:table-db-id search-ctx)
:models (:models search-ctx)})) |
+----------------------------------------------------------------------------------------------------------------+ | Endpoint | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn ^:private search-context
[{:keys [archived
created-at
created-by
last-edited-at
last-edited-by
limit
models
filter-items-in-personal-collection
offset
search-string
table-db-id
search-native-query
verified]} :- [:map {:closed true}
[:search-string [:maybe ms/NonBlankString]]
[:models [:maybe [:set SearchableModel]]]
[:archived {:optional true} [:maybe :boolean]]
[:created-at {:optional true} [:maybe ms/NonBlankString]]
[:created-by {:optional true} [:maybe [:set ms/PositiveInt]]]
[:filter-items-in-personal-collection {:optional true} [:maybe [:enum "only" "exclude"]]]
[:last-edited-at {:optional true} [:maybe ms/NonBlankString]]
[:last-edited-by {:optional true} [:maybe [:set ms/PositiveInt]]]
[:limit {:optional true} [:maybe ms/Int]]
[:offset {:optional true} [:maybe ms/Int]]
[:table-db-id {:optional true} [:maybe ms/PositiveInt]]
[:search-native-query {:optional true} [:maybe boolean?]]
[:verified {:optional true} [:maybe true?]]]] :- SearchContext
(when (some? verified)
(premium-features/assert-has-any-features
[:content-verification :official-collections]
(deferred-tru "Content Management or Official Collections")))
(let [models (if (string? models) [models] models)
ctx (cond-> {:search-string search-string
:current-user-perms @api/*current-user-permissions-set*
:archived? (boolean archived)
:models models}
(some? created-at) (assoc :created-at created-at)
(seq created-by) (assoc :created-by created-by)
(some? filter-items-in-personal-collection) (assoc :filter-items-in-personal-collection filter-items-in-personal-collection)
(some? last-edited-at) (assoc :last-edited-at last-edited-at)
(seq last-edited-by) (assoc :last-edited-by last-edited-by)
(some? table-db-id) (assoc :table-db-id table-db-id)
(some? limit) (assoc :limit-int limit)
(some? offset) (assoc :offset-int offset)
(some? search-native-query) (assoc :search-native-query search-native-query)
(some? verified) (assoc :verified verified))]
(assoc ctx :models (search.filter/search-context->applicable-models ctx)))) | |
/models TODO maybe deprecate this and make it as a parameter in | (api/defendpoint GET
"Get the set of models that a search query will return"
[q archived table-db-id created_at created_by last_edited_at last_edited_by
filter_items_in_personal_collection search_native_query verified]
{archived [:maybe ms/BooleanValue]
table-db-id [:maybe ms/PositiveInt]
created_at [:maybe ms/NonBlankString]
created_by [:maybe [:or ms/PositiveInt [:sequential ms/PositiveInt]]]
last_edited_at [:maybe ms/PositiveInt]
last_edited_by [:maybe [:or ms/PositiveInt [:sequential ms/PositiveInt]]]
search_native_query [:maybe true?]
verified [:maybe true?]}
(query-model-set (search-context {:search-string q
:archived archived
:table-db-id table-db-id
:created-at created_at
:created-by (set (u/one-or-many created_by))
:filter-items-in-personal-collection filter_items_in_personal_collection
:last-edited-at last_edited_at
:last-edited-by (set (u/one-or-many last_edited_by))
:search-native-query search_native_query
:verified verified
:models search.config/all-models}))) |
/ | (api/defendpoint GET
"Search for items in Metabase.
For the list of supported models, check [[metabase.search.config/all-models]].
Filters:
- `archived`: set to true to search archived items only, default is false
- `table_db_id`: search for tables, cards, and models of a certain DB
- `models`: only search for items of specific models. If not provided, search for all models
- `filters_items_in_personal_collection`: only search for items in personal collections
- `created_at`: search for items created at a specific timestamp
- `created_by`: search for items created by a specific user
- `last_edited_at`: search for items last edited at a specific timestamp
- `last_edited_by`: search for items last edited by a specific user
- `search_native_query`: set to true to search the content of native queries
- `verified`: set to true to search for verified items only (requires Content Management or Official Collections premium feature)
Note that not all item types support all filters, and the results will include only models that support the provided filters. For example:
- The `created-by` filter supports dashboards, models, actions, and cards.
- The `verified` filter supports models and cards.
A search query that has both filters applied will only return models and cards."
[q archived context created_at created_by table_db_id models last_edited_at last_edited_by
filter_items_in_personal_collection search_native_query verified]
{q [:maybe ms/NonBlankString]
archived [:maybe :boolean]
table_db_id [:maybe ms/PositiveInt]
models [:maybe [:or SearchableModel [:sequential SearchableModel]]]
filter_items_in_personal_collection [:maybe [:enum "only" "exclude"]]
context [:maybe [:enum "search-bar" "search-app"]]
created_at [:maybe ms/NonBlankString]
created_by [:maybe [:or ms/PositiveInt [:sequential ms/PositiveInt]]]
last_edited_at [:maybe ms/NonBlankString]
last_edited_by [:maybe [:or ms/PositiveInt [:sequential ms/PositiveInt]]]
search_native_query [:maybe true?]
verified [:maybe true?]}
(api/check-valid-page-params mw.offset-paging/*limit* mw.offset-paging/*offset*)
(let [start-time (System/currentTimeMillis)
models-set (cond
(nil? models) search.config/all-models
(string? models) #{models}
:else (set models))
results (search (search-context
{:search-string q
:archived archived
:created-at created_at
:created-by (set (u/one-or-many created_by))
:filter-items-in-personal-collection filter_items_in_personal_collection
:last-edited-at last_edited_at
:last-edited-by (set (u/one-or-many last_edited_by))
:table-db-id table_db_id
:models models-set
:limit mw.offset-paging/*limit*
:offset mw.offset-paging/*offset*
:search-native-query search_native_query
:verified verified}))
duration (- (System/currentTimeMillis) start-time)
has-advanced-filters (some some?
[models created_by created_at last_edited_by
last_edited_at search_native_query verified])]
(when (contains? #{"search-app" "search-bar"} context)
(snowplow/track-event! ::snowplow/new-search-query api/*current-user-id*
{:runtime-milliseconds duration
:context context})
(when has-advanced-filters
(snowplow/track-event! ::snowplow/search-results-filtered api/*current-user-id*
{:runtime-milliseconds duration
:content-type (u/one-or-many models)
:creator (some? created_by)
:creation-date (some? created_at)
:last-editor (some? last_edited_by)
:last-edit-date (some? last_edited_at)
:verified-items (some? verified)
:search-native-queries (some? search_native_query)})))
results)) |
(api/define-routes) | |
/api/segment endpoints. | (ns metabase.api.segment (:require [compojure.core :refer [DELETE GET POST PUT]] [metabase.api.common :as api] [metabase.events :as events] [metabase.mbql.normalize :as mbql.normalize] [metabase.models.interface :as mi] [metabase.models.revision :as revision] [metabase.models.segment :as segment :refer [Segment]] [metabase.related :as related] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
/ | (api/defendpoint POST
"Create a new `Segment`."
[:as {{:keys [name description table_id definition], :as body} :body}]
{name ms/NonBlankString
table_id ms/PositiveInt
definition ms/Map
description [:maybe :string]}
;; TODO - why can't we set other properties like `show_in_getting_started` when we create the Segment?
(api/create-check Segment body)
(let [segment (api/check-500
(first (t2/insert-returning-instances! Segment
:table_id table_id
:creator_id api/*current-user-id*
:name name
:description description
:definition definition)))]
(events/publish-event! :event/segment-create {:object segment :user-id api/*current-user-id*})
(t2/hydrate segment :creator))) |
(mu/defn ^:private hydrated-segment [id :- ms/PositiveInt]
(-> (api/read-check (t2/select-one Segment :id id))
(t2/hydrate :creator))) | |
/:id | (api/defendpoint GET
"Fetch `Segment` with ID."
[id]
{id ms/PositiveInt}
(hydrated-segment id)) |
/ | (api/defendpoint GET
"Fetch *all* `Segments`."
[]
(as-> (t2/select Segment, :archived false, {:order-by [[:%lower.name :asc]]}) segments
(filter mi/can-read? segments)
(t2/hydrate segments :creator :definition_description))) |
Check whether current user has write permissions, then update Segment with values in | (defn- write-check-and-update-segment!
[id {:keys [revision_message], :as body}]
(let [existing (api/write-check Segment id)
clean-body (u/select-keys-when body
:present #{:description :caveats :points_of_interest}
:non-nil #{:archived :definition :name :show_in_getting_started})
new-def (->> clean-body :definition (mbql.normalize/normalize-fragment []))
new-body (merge
(dissoc clean-body :revision_message)
(when new-def {:definition new-def}))
changes (when-not (= new-body existing)
new-body)
archive? (:archived changes)]
(when changes
(t2/update! Segment id changes))
(u/prog1 (hydrated-segment id)
(events/publish-event! (if archive? :event/segment-delete :event/segment-update)
{:object <> :user-id api/*current-user-id* :revision-message revision_message})))) |
/:id | (api/defendpoint PUT
"Update a `Segment` with ID."
[id :as {{:keys [name definition revision_message archived caveats description points_of_interest
show_in_getting_started]
:as body} :body}]
{id ms/PositiveInt
name [:maybe ms/NonBlankString]
definition [:maybe :map]
revision_message ms/NonBlankString
archived [:maybe :boolean]
caveats [:maybe :string]
description [:maybe :string]
points_of_interest [:maybe :string]
show_in_getting_started [:maybe :boolean]}
(write-check-and-update-segment! id body)) |
/:id | (api/defendpoint DELETE
"Archive a Segment. (DEPRECATED -- Just pass updated value of `:archived` to the `PUT` endpoint instead.)"
[id revision_message]
{id ms/PositiveInt
revision_message ms/NonBlankString}
(log/warn
(trs "DELETE /api/segment/:id is deprecated. Instead, change its `archived` value via PUT /api/segment/:id."))
(write-check-and-update-segment! id {:archived true, :revision_message revision_message})
api/generic-204-no-content) |
/:id/revisions | (api/defendpoint GET
"Fetch `Revisions` for `Segment` with ID."
[id]
{id ms/PositiveInt}
(api/read-check Segment id)
(revision/revisions+details Segment id)) |
/:id/revert | (api/defendpoint POST
"Revert a `Segement` to a prior `Revision`."
[id :as {{:keys [revision_id]} :body}]
{id ms/PositiveInt
revision_id ms/PositiveInt}
(api/write-check Segment id)
(revision/revert!
{:entity Segment
:id id
:user-id api/*current-user-id*
:revision-id revision_id})) |
/:id/related | (api/defendpoint GET
"Return related entities."
[id]
{id ms/PositiveInt}
(-> (t2/select-one Segment :id id) api/read-check related/related)) |
(api/define-routes) | |
/api/session endpoints | (ns metabase.api.session (:require [compojure.core :refer [DELETE GET POST]] [java-time.api :as t] [metabase.analytics.snowplow :as snowplow] [metabase.api.common :as api] [metabase.api.ldap :as api.ldap] [metabase.config :as config] [metabase.email.messages :as messages] [metabase.events :as events] [metabase.integrations.google :as google] [metabase.integrations.ldap :as ldap] [metabase.models :refer [PulseChannel]] [metabase.models.login-history :refer [LoginHistory]] [metabase.models.pulse :as pulse] [metabase.models.session :refer [Session]] [metabase.models.setting :as setting :refer [defsetting]] [metabase.models.user :as user :refer [User]] [metabase.public-settings :as public-settings] [metabase.server.middleware.session :as mw.session] [metabase.server.request.util :as request.u] [metabase.util :as u] [metabase.util.i18n :refer [deferred-tru trs tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [metabase.util.password :as u.password] [throttle.core :as throttle] [toucan2.core :as t2]) (:import (com.unboundid.util LDAPSDKException) (java.util UUID))) |
(set! *warn-on-reflection* true) | |
(mu/defn ^:private record-login-history!
[session-id :- (ms/InstanceOfClass UUID)
user-id :- ms/PositiveInt
device-info :- request.u/DeviceInfo]
(t2/insert! LoginHistory (merge {:user_id user-id
:session_id (str session-id)}
device-info))) | |
Generate a new Session for a User. | (defmulti create-session!
{:arglists '(^java.util.UUID [session-type user device-info])}
(fn [session-type & _]
session-type)) |
(def ^:private CreateSessionUserInfo [:map [:id ms/PositiveInt] [:last_login :any]]) | |
(def ^:private SessionSchema
[:and
[:map-of :keyword :any]
[:map
[:id (ms/InstanceOfClass UUID)]
[:type [:enum :normal :full-app-embed]]]]) | |
(mu/defmethod create-session! :sso :- SessionSchema
[_ user :- CreateSessionUserInfo device-info :- request.u/DeviceInfo]
(let [session-uuid (random-uuid)
session (first (t2/insert-returning-instances! Session
:id (str session-uuid)
:user_id (u/the-id user)))]
(assert (map? session))
(let [event {:user-id (u/the-id user)}]
(events/publish-event! :event/user-login event)
(when (nil? (:last_login user))
(events/publish-event! :event/user-joined event)))
(record-login-history! session-uuid (u/the-id user) device-info)
(when-not (:last_login user)
(snowplow/track-event! ::snowplow/new-user-created (u/the-id user)))
(assoc session :id session-uuid))) | |
(mu/defmethod create-session! :password :- SessionSchema
[session-type
user :- CreateSessionUserInfo
device-info :- request.u/DeviceInfo]
;; this is actually the same as `create-session!` for `:sso` but we check whether password login is enabled.
(when-not (public-settings/enable-password-login)
(throw (ex-info (str (tru "Password login is disabled for this instance.")) {:status-code 400})))
((get-method create-session! :sso) session-type user device-info)) | |
API Endpoints | |
(def ^:private login-throttlers
{:username (throttle/make-throttler :username)
;; IP Address doesn't have an actual UI field so just show error by username
:ip-address (throttle/make-throttler :username, :attempts-threshold 50)}) | |
(def ^:private password-fail-message (deferred-tru "Password did not match stored password.")) (def ^:private password-fail-snippet (deferred-tru "did not match stored password")) | |
(def ^:private disabled-account-message (deferred-tru "Your account is disabled. Please contact your administrator.")) (def ^:private disabled-account-snippet (deferred-tru "Your account is disabled.")) | |
Fake salt & hash used to run bcrypt hash if user doesn't exist, to avoid timing attacks (Metaboat #134) | (def ^:private fake-salt "ee169694-5eb6-4010-a145-3557252d7807") (def ^:private fake-hashed-password "$2a$10$owKjTym0ZGEEZOpxM0UyjekSvt66y1VvmOJddkAaMB37e0VAIVOX2") |
(mu/defn ^:private ldap-login :- [:maybe [:map [:id (ms/InstanceOfClass UUID)]]]
"If LDAP is enabled and a matching user exists return a new Session for them, or `nil` if they couldn't be
authenticated."
[username password device-info :- request.u/DeviceInfo]
(when (api.ldap/ldap-enabled)
(try
(when-let [user-info (ldap/find-user username)]
(when-not (ldap/verify-password user-info password)
;; Since LDAP knows about the user, fail here to prevent the local strategy to be tried with a possibly
;; outdated password
(throw (ex-info (str password-fail-message)
{:status-code 401
:errors {:password password-fail-snippet}})))
;; password is ok, return new session if user is not deactivated
(let [user (ldap/fetch-or-create-user! user-info)]
(if (:is_active user)
(create-session! :sso user device-info)
(throw (ex-info (str disabled-account-message)
{:status-code 401
:errors {:_error disabled-account-snippet}})))))
(catch LDAPSDKException e
(log/error e (trs "Problem connecting to LDAP server, will fall back to local authentication")))))) | |
(mu/defn ^:private email-login :- [:maybe [:map [:id (ms/InstanceOfClass UUID)]]]
"Find a matching `User` if one exists and return a new Session for them, or `nil` if they couldn't be authenticated."
[username :- ms/NonBlankString
password :- [:maybe ms/NonBlankString]
device-info :- request.u/DeviceInfo]
(if-let [user (t2/select-one [User :id :password_salt :password :last_login :is_active], :%lower.email (u/lower-case-en username))]
(when (u.password/verify-password password (:password_salt user) (:password user))
(if (:is_active user)
(create-session! :password user device-info)
(throw (ex-info (str disabled-account-message)
{:status-code 401
:errors {:_error disabled-account-snippet}}))))
(do
;; User doesn't exist; run bcrypt hash anyway to avoid leaking account existence in request timing
(u.password/verify-password password fake-salt fake-hashed-password)
nil))) | |
(def ^:private throttling-disabled? (config/config-bool :mb-disable-session-throttle)) | |
Pass through to | (defn- throttle-check
[throttler throttle-key]
(when-not throttling-disabled?
(throttle/check throttler throttle-key))) |
(mu/defn ^:private login :- SessionSchema
"Attempt to login with different avaialable methods with `username` and `password`, returning new Session ID or
throwing an Exception if login could not be completed."
[username :- ms/NonBlankString
password :- ms/NonBlankString
device-info :- request.u/DeviceInfo]
;; Primitive "strategy implementation", should be reworked for modular providers in #3210
(or (ldap-login username password device-info) ; First try LDAP if it's enabled
(email-login username password device-info) ; Then try local authentication
;; If nothing succeeded complain about it
;; Don't leak whether the account doesn't exist or the password was incorrect
(throw
(ex-info (str password-fail-message)
{:status-code 401
:errors {:password password-fail-snippet}})))) | |
(defn- do-http-401-on-error [f]
(try
(f)
(catch clojure.lang.ExceptionInfo e
(throw (ex-info (ex-message e)
(assoc (ex-data e) :status-code 401)))))) | |
Add | (defmacro http-401-on-error [& body] `(do-http-401-on-error (fn [] ~@body))) |
/ | (api/defendpoint POST
"Login."
[:as {{:keys [username password]} :body, :as request}]
{username ms/NonBlankString
password ms/NonBlankString}
(let [ip-address (request.u/ip-address request)
request-time (t/zoned-date-time (t/zone-id "GMT"))
do-login (fn []
(let [{session-uuid :id, :as session} (login username password (request.u/device-info request))
response {:id (str session-uuid)}]
(mw.session/set-session-cookies request response session request-time)))]
(if throttling-disabled?
(do-login)
(http-401-on-error
(throttle/with-throttling [(login-throttlers :ip-address) ip-address
(login-throttlers :username) username]
(do-login)))))) |
/ | (api/defendpoint DELETE
"Logout."
[:as {:keys [metabase-session-id]}]
(api/check-exists? Session metabase-session-id)
(t2/delete! Session :id metabase-session-id)
(mw.session/clear-session-cookie api/generic-204-no-content)) |
Reset tokens: We need some way to match a plaintext token with the a user since the token stored in the DB is hashed. So we'll make the plaintext token in the format USER-ID_RANDOM-UUID, e.g. "100_8a266560-e3a8-4dc1-9cd1-b4471dcd56d7", before hashing it. "Leaking" the ID this way is ok because the plaintext token is only sent in the password reset email to the user in question. There's also no need to salt the token because it's already random <3 | |
(def ^:private forgot-password-throttlers
{:email (throttle/make-throttler :email)
:ip-address (throttle/make-throttler :email, :attempts-threshold 50)}) | |
(defn- forgot-password-impl
[email]
(future
(when-let [{user-id :id
sso-source :sso_source
is-active? :is_active :as user}
(t2/select-one [User :id :sso_source :is_active]
:%lower.email
(u/lower-case-en email))]
(if (some? sso-source)
;; If user uses any SSO method to log in, no need to generate a reset token
(messages/send-password-reset-email! email sso-source nil is-active?)
(let [reset-token (user/set-password-reset-token! user-id)
password-reset-url (str (public-settings/site-url) "/auth/reset_password/" reset-token)]
(log/info password-reset-url)
(messages/send-password-reset-email! email nil password-reset-url is-active?)))
(events/publish-event! :event/password-reset-initiated
{:object (assoc user :token (t2/select-one-fn :reset_token :model/User :id user-id))})))) | |
/forgot_password | (api/defendpoint POST
"Send a reset email when user has forgotten their password."
[:as {{:keys [email]} :body, :as request}]
{email ms/Email}
;; Don't leak whether the account doesn't exist, just pretend everything is ok
(let [request-source (request.u/ip-address request)]
(throttle-check (forgot-password-throttlers :ip-address) request-source))
(throttle-check (forgot-password-throttlers :email) email)
(forgot-password-impl email)
api/generic-204-no-content) |
(defsetting reset-token-ttl-hours (deferred-tru "Number of hours a password reset is considered valid.") :visibility :internal :type :integer :default 48 :audit :getter) | |
number of milliseconds a password reset is considered valid. | (defn reset-token-ttl-ms [] (* (reset-token-ttl-hours) 60 60 1000)) |
Check if a password reset token is valid. If so, return the | (defn- valid-reset-token->user
[^String token]
(when-let [[_ user-id] (re-matches #"(^\d+)_.+$" token)]
(let [user-id (Integer/parseInt user-id)]
(when-let [{:keys [reset_token reset_triggered], :as user} (t2/select-one [User :id :last_login :reset_triggered
:reset_token]
:id user-id, :is_active true)]
;; Make sure the plaintext token matches up with the hashed one for this user
(when (u/ignore-exceptions
(u.password/bcrypt-verify token reset_token))
;; check that the reset was triggered within the last 48 HOURS, after that the token is considered expired
(let [token-age (- (System/currentTimeMillis) reset_triggered)]
(when (< token-age (reset-token-ttl-ms))
user))))))) |
/reset_password | (api/defendpoint POST
"Reset password with a reset token."
[:as {{:keys [token password]} :body, :as request}]
{token ms/NonBlankString
password ms/ValidPassword}
(or (when-let [{user-id :id, :as user} (valid-reset-token->user token)]
(let [reset-token (t2/select-one-fn :reset_token :model/User :id user-id)]
(user/set-password! user-id password)
;; if this is the first time the user has logged in it means that they're just accepted their Metabase invite.
;; Otherwise, send audit log event that a user reset their password.
(if (:last_login user)
(events/publish-event! :event/password-reset-successful {:object (assoc user :token reset-token)})
;; Send all the active admins an email :D
(messages/send-user-joined-admin-notification-email! (t2/select-one User :id user-id)))
;; after a successful password update go ahead and offer the client a new session that they can use
(let [{session-uuid :id, :as session} (create-session! :password user (request.u/device-info request))
response {:success true
:session_id (str session-uuid)}]
(mw.session/set-session-cookies request response session (t/zoned-date-time (t/zone-id "GMT"))))))
(api/throw-invalid-param-exception :password (tru "Invalid reset token")))) |
/passwordresettoken_valid | (api/defendpoint GET
"Check is a password reset token is valid and isn't expired."
[token]
{token ms/NonBlankString}
{:valid (boolean (valid-reset-token->user token))}) |
/properties | (api/defendpoint GET "Get all properties and their values. These are the specific `Settings` that are readable by the current user, or are public if no user is logged in." [] (setting/user-readable-values-map (setting/current-user-readable-visibilities))) |
/google_auth | (api/defendpoint POST
"Login with Google Auth."
[:as {{:keys [token]} :body, :as request}]
{token ms/NonBlankString}
(when-not (google/google-auth-client-id)
(throw (ex-info "Google Auth is disabled." {:status-code 400})))
;; Verify the token is valid with Google
(if throttling-disabled?
(google/do-google-auth request)
(http-401-on-error
(throttle/with-throttling [(login-throttlers :ip-address) (request.u/ip-address request)]
(let [user (google/do-google-auth request)
{session-uuid :id, :as session} (create-session! :sso user (request.u/device-info request))
response {:id (str session-uuid)}
user (t2/select-one [User :id :is_active], :email (:email user))]
(if (and user (:is_active user))
(mw.session/set-session-cookies request
response
session
(t/zoned-date-time (t/zone-id "GMT")))
(throw (ex-info (str disabled-account-message)
{:status-code 401
:errors {:account disabled-account-snippet}})))))))) |
(defn- +log-all-request-failures [handler]
(fn [request respond raise]
(try
(handler request respond raise)
(catch Throwable e
(log/error e (trs "Authentication endpoint error"))
(throw e))))) | |
----------------------------------------------------- Unsubscribe non-users from pulses ----------------------------------------------- | |
(def ^:private unsubscribe-throttler (throttle/make-throttler :unsubscribe, :attempts-threshold 50)) | |
(defn- check-hash [pulse-id email hash ip-address]
(throttle-check unsubscribe-throttler ip-address)
(when (not= hash (messages/generate-pulse-unsubscribe-hash pulse-id email))
(throw (ex-info (tru "Invalid hash.")
{:type type
:status-code 400})))) | |
/pulse/unsubscribe | (api/defendpoint POST
"Allow non-users to unsubscribe from pulses/subscriptions, with the hash given through email."
[:as {{:keys [email hash pulse-id]} :body, :as request}]
{pulse-id ms/PositiveInt
email :string
hash :string}
(check-hash pulse-id email hash (request.u/ip-address request))
(t2/with-transaction [_conn]
(api/let-404 [pulse-channel (t2/select-one PulseChannel :pulse_id pulse-id :channel_type "email")]
(let [emails (get-in pulse-channel [:details :emails])]
(if (some #{email} emails)
(t2/update! PulseChannel (:id pulse-channel) (update-in pulse-channel [:details :emails] #(remove #{email} %)))
(throw (ex-info (tru "Email for pulse-id doesn't exist.")
{:type type
:status-code 400}))))
(events/publish-event! :event/subscription-unsubscribe {:object {:email email}})
{:status :success :title (:name (pulse/retrieve-notification pulse-id :archived false))}))) |
/pulse/unsubscribe/undo | (api/defendpoint POST
"Allow non-users to undo an unsubscribe from pulses/subscriptions, with the hash given through email."
[:as {{:keys [email hash pulse-id]} :body, :as request}]
{pulse-id ms/PositiveInt
email :string
hash :string}
(check-hash pulse-id email hash (request.u/ip-address request))
(t2/with-transaction [_conn]
(api/let-404 [pulse-channel (t2/select-one PulseChannel :pulse_id pulse-id :channel_type "email")]
(let [emails (get-in pulse-channel [:details :emails])]
(if (some #{email} emails)
(throw (ex-info (tru "Email for pulse-id already exists.")
{:type type
:status-code 400}))
(t2/update! PulseChannel (:id pulse-channel) (update-in pulse-channel [:details :emails] conj email))))
(events/publish-event! :event/subscription-unsubscribe-undo {:object {:email email}})
{:status :success :title (:name (pulse/retrieve-notification pulse-id :archived false))}))) |
(api/define-routes +log-all-request-failures) | |
/api/setting endpoints | (ns metabase.api.setting (:require [compojure.core :refer [GET PUT]] [metabase.api.common :as api] [metabase.api.common.validation :as validation] [metabase.models.setting :as setting] [metabase.util :as u])) |
(defn- do-with-setting-access-control
[thunk]
(try
(binding [setting/*enforce-setting-access-checks* true]
(thunk))
(catch clojure.lang.ExceptionInfo e
;; Throw a generic 403 for non-admins, so as to not reveal details about settings
(api/check-superuser)
(throw e)))) | |
Executes the given body with setting access enforcement enabled, and adds some exception handling to make sure we return generic 403s to non-admins who try to read or write settings they don't have access to. | (defmacro ^:private with-setting-access-control [& body] `(do-with-setting-access-control (fn [] ~@body))) |
/ TODO: deprecate /api/session/properties and have a single endpoint for listing settings | (api/defendpoint GET "Get all `Settings` and their values. You must be a superuser or have `setting` permission to do this. For non-superusers, a list of visible settings and values can be retrieved using the /api/session/properties endpoint." [] (validation/check-has-application-permission :setting) (setting/writable-settings)) |
Keyword that can be transformed from "a_b" -> :a-b | (def ^:private kebab-cased-keyword
[:keyword {:decode/json #(keyword (u/->kebab-case-en %))}]) |
/ | (api/defendpoint PUT
"Update multiple `Settings` values. If called by a non-superuser, only user-local settings can be updated."
[:as {settings :body}]
{settings [:map-of kebab-cased-keyword :any]}
(with-setting-access-control
(setting/set-many! settings))
api/generic-204-no-content) |
/:key | (api/defendpoint GET
"Fetch a single `Setting`."
[key]
{key kebab-cased-keyword}
(with-setting-access-control
(setting/user-facing-value key))) |
/:key | (api/defendpoint PUT
"Create/update a `Setting`. If called by a non-admin, only user-local settings can be updated.
This endpoint can also be used to delete Settings by passing `nil` for `:value`."
[key :as {{:keys [value]} :body}]
{key kebab-cased-keyword}
(with-setting-access-control
(setting/set! key value))
api/generic-204-no-content) |
(api/define-routes) | |
(ns metabase.api.setup (:require [compojure.core :refer [GET POST]] [java-time.api :as t] [metabase.analytics.snowplow :as snowplow] [metabase.api.common :as api] [metabase.api.common.validation :as validation] [metabase.api.database :as api.database] [metabase.config :as config] [metabase.db :as mdb] [metabase.driver :as driver] [metabase.email :as email] [metabase.events :as events] [metabase.integrations.slack :as slack] [metabase.models.card :refer [Card]] [metabase.models.collection :refer [Collection]] [metabase.models.dashboard :refer [Dashboard]] [metabase.models.database :refer [Database]] [metabase.models.permissions-group :as perms-group] [metabase.models.pulse :refer [Pulse]] [metabase.models.session :refer [Session]] [metabase.models.setting.cache :as setting.cache] [metabase.models.table :refer [Table]] [metabase.models.user :as user :refer [User]] [metabase.public-settings :as public-settings] [metabase.public-settings.premium-features :as premium-features] [metabase.server.middleware.session :as mw.session] [metabase.setup :as setup] [metabase.sync.schedules :as sync.schedules] [metabase.util :as u] [metabase.util.i18n :as i18n :refer [trs tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) | |
(set! *warn-on-reflection* true) | |
Schema for a string that matches the instance setup token. | (def ^:private ^:deprcated SetupToken
(mu/with-api-error-message
[:and
ms/NonBlankString
[:fn
{:error/message "setup token"}
(every-pred string? #'setup/token-match?)]]
(i18n/deferred-tru "Token does not match the setup token."))) |
We must not allow users to setup multiple super users after the first user is created. But tests still need to be able to. This var is redef'd to false by certain tests to allow that. | (def ^:dynamic ^:private *allow-api-setup-after-first-user-is-created* false) |
(defn- setup-create-user! [{:keys [email first-name last-name password]}]
(when (and (setup/has-user-setup)
(not *allow-api-setup-after-first-user-is-created*))
;; many tests use /api/setup to setup multiple users, so *allow-api-setup-after-first-user-is-created* is
;; redefined by them
(throw (ex-info
(tru "The /api/setup route can only be used to create the first user, however a user currently exists.")
{:status-code 403})))
(let [session-id (str (random-uuid))
new-user (first (t2/insert-returning-instances! User
:email email
:first_name first-name
:last_name last-name
:password (str (random-uuid))
:is_superuser true))
user-id (u/the-id new-user)]
;; this results in a second db call, but it avoids redundant password code so figure it's worth it
(user/set-password! user-id password)
;; then we create a session right away because we want our new user logged in to continue the setup process
(let [session (first (t2/insert-returning-instances! Session
:id session-id
:user_id user-id))]
;; return user ID, session ID, and the Session object itself
{:session-id session-id, :user-id user-id, :session session}))) | |
(defn- setup-maybe-create-and-invite-user! [{:keys [email] :as user}, invitor]
(when email
(if-not (email/email-configured?)
(log/error (trs "Could not invite user because email is not configured."))
(u/prog1 (user/create-and-invite-user! user invitor true)
(user/set-permissions-groups! <> [(perms-group/all-users) (perms-group/admin)])
(events/publish-event! :event/user-invited {:object (assoc <> :invite_method "email")})
(snowplow/track-event! ::snowplow/invite-sent api/*current-user-id* {:invited-user-id (u/the-id <>)
:source "setup"}))))) | |
Create a new Database. Returns newly created Database. | (defn- setup-create-database!
[{:keys [name driver details schedules database creator-id]}]
(when driver
(when-not (some-> (u/ignore-exceptions (driver/the-driver driver)) driver/available?)
(let [msg (tru "Cannot create Database: cannot find driver {0}." driver)]
(throw (ex-info msg {:errors {:database {:engine msg}}, :status-code 400}))))
(when-let [error (api.database/test-database-connection driver details)]
(throw (ex-info (:message error (tru "Cannot connect to Database")) (assoc error :status-code 400))))
(first (t2/insert-returning-instances! Database
(merge
{:name name, :engine driver, :details details, :creator_id creator-id}
(u/select-non-nil-keys database #{:is_on_demand :is_full_sync :auto_run_queries})
(when schedules
(sync.schedules/schedule-map->cron-strings schedules))))))) |
(defn- setup-set-settings! [_request {:keys [email site-name site-locale allow-tracking?]}]
;; set a couple preferences
(public-settings/site-name! site-name)
(public-settings/admin-email! email)
(when site-locale
(public-settings/site-locale! site-locale))
;; default to `true` if allow_tracking isn't specified. The setting will set itself correctly whether a boolean or
;; boolean string is specified
(public-settings/anon-tracking-enabled! (or (nil? allow-tracking?)
allow-tracking?))) | |
/ | (api/defendpoint POST
"Special endpoint for creating the first user during setup. This endpoint both creates the user AND logs them in and
returns a session ID. This endpoint can also be used to add a database, create and invite a second admin, and/or
set specific settings from the setup flow."
[:as {{:keys [token]
{:keys [name engine details
schedules auto_run_queries]
:as database} :database
{:keys [first_name last_name email password]} :user
{invited_first_name :first_name,
invited_last_name :last_name,
invited_email :email} :invite
{:keys [allow_tracking site_name site_locale]} :prefs} :body, :as request}]
{token SetupToken
site_name ms/NonBlankString
site_locale [:maybe ms/ValidLocale]
first_name [:maybe ms/NonBlankString]
last_name [:maybe ms/NonBlankString]
email ms/Email
invited_first_name [:maybe ms/NonBlankString]
invited_last_name [:maybe ms/NonBlankString]
invited_email [:maybe ms/Email]
password ms/ValidPassword
allow_tracking [:maybe [:or :boolean ms/BooleanString]]
schedules [:maybe sync.schedules/ExpandedSchedulesMap]
auto_run_queries [:maybe :boolean]}
(letfn [(create! []
(try
(t2/with-transaction [_conn]
(let [user-info (setup-create-user!
{:email email, :first-name first_name, :last-name last_name, :password password})
db (setup-create-database! {:name name
:driver engine
:details details
:schedules schedules
:database database
:creator-id (:user-id user-info)})]
(setup-maybe-create-and-invite-user! {:email invited_email,
:first_name invited_first_name,
:last_name invited_last_name}
{:email email, :first_name first_name})
(setup-set-settings!
request
{:email email, :site-name site_name, :site-locale site_locale, :allow-tracking? allow_tracking})
(assoc user-info :database db)))
(catch Throwable e
;; if the transaction fails, restore the Settings cache from the DB again so any changes made in this
;; endpoint (such as clearing the setup token) are reverted. We can't use `dosync` here to accomplish
;; this because there is `io!` in this block
(setting.cache/restore-cache!)
(snowplow/track-event! ::snowplow/database-connection-failed nil {:database engine, :source :setup})
(throw e))))]
(let [{:keys [user-id session-id database session]} (create!)
superuser (t2/select-one :model/User :id user-id)]
(when database
(events/publish-event! :event/database-create {:object database :user-id user-id}))
(events/publish-event! :event/user-login {:user-id user-id})
(when-not (:last_login superuser)
(events/publish-event! :event/user-joined {:user-id user-id}))
(snowplow/track-event! ::snowplow/new-user-created user-id)
(when database
(snowplow/track-event! ::snowplow/database-connection-successful
user-id
{:database engine
:database-id (u/the-id database)
:source :setup
:dbms_version (:version (driver/dbms-version (keyword engine) database))}))
;; return response with session ID and set the cookie as well
(mw.session/set-session-cookies request {:id session-id} session (t/zoned-date-time (t/zone-id "GMT")))))) |
/validate | (api/defendpoint POST
"Validate that we can connect to a database given a set of details."
[:as {{{:keys [engine details]} :details, token :token} :body}]
{token SetupToken
engine api.database/DBEngineString}
(when (setup/has-user-setup)
(throw (ex-info (tru "Instance already initialized")
{:status-code 400})))
(let [engine (keyword engine)
error-or-nil (api.database/test-database-connection engine details)]
(when error-or-nil
(snowplow/track-event! ::snowplow/database-connection-failed
nil
{:database engine, :source :setup})
{:status 400
:body error-or-nil}))) |
Admin Checklist | |
Malli schema for the state to annotate the checklist. | (def ^:private ChecklistState
[:map {:closed true}
[:db-type [:enum :h2 :mysql :postgres]]
[:hosted? :boolean]
[:configured [:map
[:email :boolean]
[:slack :boolean]]]
[:counts [:map
[:user :int]
[:card :int]
[:table :int]]]
[:exists [:map
[:model :boolean]
[:non-sample-db :boolean]
[:dashboard :boolean]
[:pulse :boolean]
[:hidden-table :boolean]
[:collection :boolean]]]]) |
(mu/defn ^:private state-for-checklist :- ChecklistState
[]
{:db-type (mdb/db-type)
:hosted? (premium-features/is-hosted?)
:configured {:email (email/email-configured?)
:slack (slack/slack-configured?)}
:counts {:user (t2/count User)
:card (t2/count Card)
:table (t2/count Table)}
:exists {:non-sample-db (t2/exists? Database, :is_sample false)
:dashboard (t2/exists? Dashboard)
:pulse (t2/exists? Pulse)
:hidden-table (t2/exists? Table, :visibility_type [:not= nil])
:collection (t2/exists? Collection)
:model (t2/exists? Card :dataset true)}}) | |
(defn- get-connected-tasks
[{:keys [configured counts exists] :as _info}]
[{:title (tru "Add a database")
:group (tru "Get connected")
:description (tru "Connect to your data so your whole team can start to explore.")
:link "/admin/databases/create"
:completed (exists :non-sample-db)
:triggered :always}
{:title (tru "Set up email")
:group (tru "Get connected")
:description (tru "Add email credentials so you can more easily invite team members and get updates via Pulses.")
:link "/admin/settings/email"
:completed (configured :email)
:triggered :always}
{:title (tru "Set Slack credentials")
:group (tru "Get connected")
:description (tru "Does your team use Slack? If so, you can send automated updates via dashboard subscriptions.")
:link "/admin/settings/slack"
:completed (configured :slack)
:triggered :always}
{:title (tru "Invite team members")
:group (tru "Get connected")
:description (tru "Share answers and data with the rest of your team.")
:link "/admin/people/"
:completed (> (counts :user) 1)
:triggered (or (exists :dashboard)
(exists :pulse)
(>= (counts :card) 5))}]) | |
(defn- productionize-tasks
[info]
[{:title (tru "Switch to a production-ready app database")
:group (tru "Productionize")
:description (tru "Migrate off of the default H2 application database to PostgreSQL or MySQL")
:link "https://www.metabase.com/docs/latest/installation-and-operation/migrating-from-h2"
:completed (not= (:db-type info) :h2)
:triggered (and (= (:db-type info) :h2) (not (:hosted? info)))}]) | |
(defn- curate-tasks
[{:keys [counts exists] :as _info}]
[{:title (tru "Hide irrelevant tables")
:group (tru "Curate your data")
:description (tru "If your data contains technical or irrelevant info you can hide it.")
:link "/admin/datamodel/database"
:completed (exists :hidden-table)
:triggered (>= (counts :table) 20)}
{:title (tru "Organize questions")
:group (tru "Curate your data")
:description (tru "Have a lot of saved questions in {0}? Create collections to help manage them and add context." (tru "Metabase"))
:link "/collection/root"
:completed (exists :collection)
:triggered (>= (counts :card) 30)}
{:title (tru "Create a model")
:group (tru "Curate your data")
:description (tru "Set up friendly starting points for your team to explore data")
:link "/model/new"
:completed (exists :model)
:triggered (not (exists :model))}]) | |
(mu/defn ^:private checklist-items
[info :- ChecklistState]
(remove nil?
[{:name (tru "Get connected")
:tasks (get-connected-tasks info)}
(when-not (:hosted? info)
{:name (tru "Productionize")
:tasks (productionize-tasks info)})
{:name (tru "Curate your data")
:tasks (curate-tasks info)}])) | |
Add | (defn- annotate
[checklist]
(let [next-step (->> checklist
(mapcat :tasks)
(filter (every-pred :triggered (complement :completed)))
first
:title)
mark-next-step (fn identity-task-by-name [task]
(assoc task :is_next_step (= (:title task) next-step)))
update-triggered (fn [task]
(update task :triggered boolean))]
(for [group checklist]
(update group :tasks
(partial map (comp update-triggered mark-next-step)))))) |
(defn- admin-checklist ([] (admin-checklist (state-for-checklist))) ([checklist-info] (annotate (checklist-items checklist-info)))) | |
/admin_checklist | (api/defendpoint GET "Return various \"admin checklist\" steps and whether they've been completed. You must be a superuser to see this!" [] (validation/check-has-application-permission :setting) (admin-checklist)) |
User defaults endpoint | |
/user_defaults | (api/defendpoint GET
"Returns object containing default user details for initial setup, if configured,
and if the provided token value matches the token in the configuration value."
[token]
(let [{config-token :token :as defaults} (config/mb-user-defaults)]
(api/check-404 config-token)
(api/check-403 (= token config-token))
(dissoc defaults :token))) |
(api/define-routes) | |
/api/slack endpoints | (ns metabase.api.slack (:require [clojure.java.io :as io] [compojure.core :refer [PUT]] [metabase.api.common :as api] [metabase.api.common.validation :as validation] [metabase.config :as config] [metabase.integrations.slack :as slack] [metabase.util.i18n :refer [tru]] [metabase.util.malli.schema :as ms])) |
/settings | (api/defendpoint PUT
"Update Slack related settings. You must be a superuser to do this. Also updates the slack-cache.
There are 3 cases where we alter the slack channel/user cache:
1. falsy token -> clear
2. invalid token -> clear
3. truthy, valid token -> refresh "
[:as {{slack-app-token :slack-app-token, slack-files-channel :slack-files-channel} :body}]
{slack-app-token [:maybe ms/NonBlankString]
slack-files-channel [:maybe ms/NonBlankString]}
(validation/check-has-application-permission :setting)
(try
(when (and slack-app-token
(not config/is-test?)
(not (slack/valid-token? slack-app-token)))
(slack/clear-channel-cache!)
(throw (ex-info (tru "Invalid Slack token.")
{:errors {:slack-app-token (tru "invalid token")}})))
(slack/slack-app-token! slack-app-token)
(if slack-app-token
(do (slack/slack-token-valid?! true)
;; Clear the deprecated `slack-token` when setting a new `slack-app-token`
(slack/slack-token! nil)
;; refresh user/conversation cache when token is newly valid
(slack/refresh-channels-and-usernames-when-needed!))
;; clear user/conversation cache when token is newly empty
(slack/clear-channel-cache!))
(let [processed-files-channel (slack/process-files-channel-name slack-files-channel)]
(when (and processed-files-channel (not (slack/channel-exists? processed-files-channel)))
;; Files channel could not be found; clear the token we had previously set since the integration should not be
;; enabled.
(slack/slack-token-valid?! false)
(slack/slack-app-token! nil)
(throw (ex-info (tru "Slack channel not found.")
{:errors {:slack-files-channel (tru "channel not found")}})))
(slack/slack-files-channel! processed-files-channel))
{:ok true}
(catch clojure.lang.ExceptionInfo info
{:status 400, :body (ex-data info)}))) |
(def ^:private slack-manifest (delay (slurp (io/resource "slack-manifest.yaml")))) | |
/manifest | (api/defendpoint GET "Returns the YAML manifest file that should be used to bootstrap new Slack apps" [] (validation/check-has-application-permission :setting) @slack-manifest) |
(api/define-routes) | |
/api/table endpoints. | (ns metabase.api.table
(:require
[clojure.java.io :as io]
[compojure.core :refer [GET POST PUT]]
[medley.core :as m]
[metabase.api.common :as api]
[metabase.db.query :as mdb.query]
[metabase.driver :as driver]
[metabase.driver.h2 :as h2]
[metabase.driver.util :as driver.u]
[metabase.events :as events]
[metabase.models.card :refer [Card]]
[metabase.models.database :refer [Database]]
[metabase.models.field :refer [Field]]
[metabase.models.field-values :as field-values :refer [FieldValues]]
[metabase.models.interface :as mi]
[metabase.models.table :as table :refer [Table]]
[metabase.related :as related]
[metabase.sync :as sync]
[metabase.sync.concurrent :as sync.concurrent]
#_{:clj-kondo/ignore [:consistent-alias]}
[metabase.sync.field-values :as sync.field-values]
[metabase.types :as types]
[metabase.upload :as upload]
[metabase.util :as u]
[metabase.util.i18n :refer [deferred-tru trs tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
Schema for a valid table visibility type. | (def ^:private TableVisibilityType (into [:enum] (map name table/visibility-types))) |
Schema for a valid table field ordering. | (def ^:private FieldOrder (into [:enum] (map name table/field-orderings))) |
/ | (api/defendpoint GET
"Get all `Tables`."
[]
(as-> (t2/select Table, :active true, {:order-by [[:name :asc]]}) tables
(t2/hydrate tables :db)
(filterv mi/can-read? tables))) |
/:id | (api/defendpoint GET
"Get `Table` with ID."
[id include_editable_data_model]
{id ms/PositiveInt
include_editable_data_model [:maybe :boolean]}
(let [api-perm-check-fn (if include_editable_data_model
api/write-check
api/read-check)]
(-> (api-perm-check-fn Table id)
(t2/hydrate :db :pk_field)))) |
Takes an existing table and the changes, updates in the database and optionally calls | (defn- update-table!*
[{:keys [id] :as existing-table} body]
{id ms/PositiveInt}
(when-let [changes (not-empty (u/select-keys-when body
:non-nil [:display_name :show_in_getting_started :entity_type :field_order]
:present [:description :caveats :points_of_interest :visibility_type]))]
(api/check-500 (pos? (t2/update! Table id changes))))
(let [updated-table (t2/select-one Table :id id)
changed-field-order? (not= (:field_order updated-table) (:field_order existing-table))]
(if changed-field-order?
(do
(table/update-field-positions! updated-table)
(t2/hydrate updated-table [:fields [:target :has_field_values] :dimensions :has_field_values]))
updated-table))) |
Function to call on newly unhidden tables. Starts a thread to sync all tables. | (defn- sync-unhidden-tables
[newly-unhidden]
(when (seq newly-unhidden)
(sync.concurrent/submit-task
(fn []
(let [database (table/database (first newly-unhidden))]
;; it's okay to allow testing H2 connections during sync. We only want to disallow you from testing them for the
;; purposes of creating a new H2 database.
(if (binding [h2/*allow-testing-h2-connections* true]
(driver.u/can-connect-with-details? (:engine database) (:details database)))
(doseq [table newly-unhidden]
(log/info (u/format-color 'green (trs "Table ''{0}'' is now visible. Resyncing." (:name table))))
(sync/sync-table! table))
(log/warn (u/format-color 'red (trs "Cannot connect to database ''{0}'' in order to sync unhidden tables"
(:name database)))))))))) |
(defn- update-tables!
[ids {:keys [visibility_type] :as body}]
(let [existing-tables (t2/select Table :id [:in ids])]
(api/check-404 (= (count existing-tables) (count ids)))
(run! api/write-check existing-tables)
(let [updated-tables (t2/with-transaction [_conn] (mapv #(update-table!* % body) existing-tables))
newly-unhidden (when (and (contains? body :visibility_type) (nil? visibility_type))
(into [] (filter (comp some? :visibility_type)) existing-tables))]
(sync-unhidden-tables newly-unhidden)
updated-tables))) | |
/:id | (api/defendpoint PUT
"Update `Table` with ID."
[id :as {{:keys [display_name entity_type visibility_type description caveats points_of_interest
show_in_getting_started field_order], :as body} :body}]
{id ms/PositiveInt
display_name [:maybe ms/NonBlankString]
entity_type [:maybe ms/EntityTypeKeywordOrString]
visibility_type [:maybe TableVisibilityType]
description [:maybe :string]
caveats [:maybe :string]
points_of_interest [:maybe :string]
show_in_getting_started [:maybe :boolean]
field_order [:maybe FieldOrder]}
(first (update-tables! [id] body))) |
/ | (api/defendpoint PUT
"Update all `Table` in `ids`."
[:as {{:keys [ids display_name entity_type visibility_type description caveats points_of_interest
show_in_getting_started], :as body} :body}]
{ids [:sequential ms/PositiveInt]
display_name [:maybe ms/NonBlankString]
entity_type [:maybe ms/EntityTypeKeywordOrString]
visibility_type [:maybe TableVisibilityType]
description [:maybe :string]
caveats [:maybe :string]
points_of_interest [:maybe :string]
show_in_getting_started [:maybe :boolean]}
(update-tables! ids body)) |
(def ^:private auto-bin-str (deferred-tru "Auto bin")) (def ^:private dont-bin-str (deferred-tru "Don''t bin")) (def ^:private minute-str (deferred-tru "Minute")) (def ^:private hour-str (deferred-tru "Hour")) (def ^:private day-str (deferred-tru "Day")) | |
note the order of these options corresponds to the order they will be shown to the user in the UI | (def ^:private time-options [[minute-str "minute"] [hour-str "hour"] [(deferred-tru "Minute of hour") "minute-of-hour"]]) |
(def ^:private datetime-options [[minute-str "minute"] [hour-str "hour"] [day-str "day"] [(deferred-tru "Week") "week"] [(deferred-tru "Month") "month"] [(deferred-tru "Quarter") "quarter"] [(deferred-tru "Year") "year"] [(deferred-tru "Minute of hour") "minute-of-hour"] [(deferred-tru "Hour of day") "hour-of-day"] [(deferred-tru "Day of week") "day-of-week"] [(deferred-tru "Day of month") "day-of-month"] [(deferred-tru "Day of year") "day-of-year"] [(deferred-tru "Week of year") "week-of-year"] [(deferred-tru "Month of year") "month-of-year"] [(deferred-tru "Quarter of year") "quarter-of-year"]]) | |
(def ^:private date-options [[day-str "day"] [(deferred-tru "Week") "week"] [(deferred-tru "Month") "month"] [(deferred-tru "Quarter") "quarter"] [(deferred-tru "Year") "year"] [(deferred-tru "Day of week") "day-of-week"] [(deferred-tru "Day of month") "day-of-month"] [(deferred-tru "Day of year") "day-of-year"] [(deferred-tru "Week of year") "week-of-year"] [(deferred-tru "Month of year") "month-of-year"] [(deferred-tru "Quarter of year") "quarter-of-year"]]) | |
(def ^:private dimension-options
(let [default-entry [auto-bin-str ["default"]]]
(zipmap (range)
(concat
(map (fn [[name param]]
{:name name
:mbql [:field nil {:temporal-unit param}]
:type :type/Date})
date-options)
(map (fn [[name param]]
{:name name
:mbql [:field nil {:temporal-unit param}]
:type :type/DateTime})
datetime-options)
(map (fn [[name param]]
{:name name
:mbql [:field nil {:temporal-unit param}]
:type :type/Time})
time-options)
(conj
(mapv (fn [[name [strategy param]]]
{:name name
:mbql [:field nil {:binning (merge {:strategy strategy}
(when param
{strategy param}))}]
:type :type/Number})
[default-entry
[(deferred-tru "10 bins") ["num-bins" 10]]
[(deferred-tru "50 bins") ["num-bins" 50]]
[(deferred-tru "100 bins") ["num-bins" 100]]])
{:name dont-bin-str
:mbql nil
:type :type/Number})
(conj
(mapv (fn [[name [strategy param]]]
{:name name
:mbql [:field nil {:binning (merge {:strategy strategy}
(when param
{strategy param}))}]
:type :type/Coordinate})
[default-entry
[(deferred-tru "Bin every 0.1 degrees") ["bin-width" 0.1]]
[(deferred-tru "Bin every 1 degree") ["bin-width" 1.0]]
[(deferred-tru "Bin every 10 degrees") ["bin-width" 10.0]]
[(deferred-tru "Bin every 20 degrees") ["bin-width" 20.0]]])
{:name dont-bin-str
:mbql nil
:type :type/Coordinate}))))) | |
(def ^:private dimension-options-for-response (m/map-keys str dimension-options)) | |
(defn- create-dim-index-seq [dim-type]
(->> dimension-options
(m/filter-vals (fn [v] (= (:type v) dim-type)))
keys
sort
(map str))) | |
(def ^:private datetime-dimension-indexes (create-dim-index-seq :type/DateTime)) | |
(def ^:private time-dimension-indexes (create-dim-index-seq :type/Time)) | |
(def ^:private date-dimension-indexes (create-dim-index-seq :type/Date)) | |
(def ^:private numeric-dimension-indexes (create-dim-index-seq :type/Number)) | |
(def ^:private coordinate-dimension-indexes (create-dim-index-seq :type/Coordinate)) | |
(defn- dimension-index-for-type [dim-type pred]
(let [dim' (keyword dim-type)]
(first (m/find-first (fn [[_k v]]
(and (= dim' (:type v))
(pred v))) dimension-options-for-response)))) | |
(def ^:private datetime-default-index (dimension-index-for-type :type/DateTime #(= (str day-str) (str (:name %))))) | |
(def ^:private date-default-index (dimension-index-for-type :type/Date #(= (str day-str) (str (:name %))))) | |
(def ^:private time-default-index (dimension-index-for-type :type/Time #(= (str hour-str) (str (:name %))))) | |
(def ^:private numeric-default-index (dimension-index-for-type :type/Number #(.contains ^String (str (:name %)) (str auto-bin-str)))) | |
(def ^:private coordinate-default-index (dimension-index-for-type :type/Coordinate #(.contains ^String (str (:name %)) (str auto-bin-str)))) | |
(defn- supports-numeric-binning? [db] (and db (driver/database-supports? (:engine db) :binning db))) | |
TODO: Remove all this when the FE is fully ported to [[metabase.lib.binning/available-binning-strategies]]. | (defn- assoc-field-dimension-options [{:keys [base_type semantic_type fingerprint] :as field} db]
(let [{min_value :min, max_value :max} (get-in fingerprint [:type :type/Number])
[default-option all-options] (cond
(types/field-is-type? :type/Time field)
[time-default-index time-dimension-indexes]
(types/field-is-type? :type/Date field)
[date-default-index date-dimension-indexes]
(types/temporal-field? field)
[datetime-default-index datetime-dimension-indexes]
(and min_value max_value
(isa? semantic_type :type/Coordinate)
(supports-numeric-binning? db))
[coordinate-default-index coordinate-dimension-indexes]
(and min_value max_value
(isa? base_type :type/Number)
(not (isa? semantic_type :Relation/*))
(supports-numeric-binning? db))
[numeric-default-index numeric-dimension-indexes]
:else
[nil []])]
(assoc field
:default_dimension_option default-option
:dimension_options all-options))) |
(defn- assoc-dimension-options [resp db]
(-> resp
(assoc :dimension_options dimension-options-for-response)
(update :fields (fn [fields]
(mapv #(assoc-field-dimension-options % db) fields))))) | |
(defn- format-fields-for-response [resp]
(update resp :fields
(fn [fields]
(for [{:keys [values] :as field} fields]
(if (seq values)
(update field :values field-values/field-values->pairs)
field))))) | |
Returns the query metadata used to power the Query Builder for the given | (defn fetch-query-metadata
[table {:keys [include-sensitive-fields? include-hidden-fields? include-editable-data-model?]}]
(if include-editable-data-model?
(api/write-check table)
(api/read-check table))
(let [db (t2/select-one Database :id (:db_id table))]
(-> table
(t2/hydrate :db [:fields [:target :has_field_values] :dimensions :has_field_values] :segments :metrics)
(m/dissoc-in [:db :details])
(assoc-dimension-options db)
format-fields-for-response
(update :fields (partial filter (fn [{visibility-type :visibility_type}]
(case (keyword visibility-type)
:hidden include-hidden-fields?
:sensitive include-sensitive-fields?
true))))))) |
/:id/query_metadata | (api/defendpoint GET
"Get metadata about a `Table` useful for running queries.
Returns DB, fields, field FKs, and field values.
Passing `include_hidden_fields=true` will include any hidden `Fields` in the response. Defaults to `false`
Passing `include_sensitive_fields=true` will include any sensitive `Fields` in the response. Defaults to `false`.
Passing `include_editable_data_model=true` will check that the current user has write permissions for the table's
data model, while `false` checks that they have data access perms for the table. Defaults to `false`.
These options are provided for use in the Admin Edit Metadata page."
[id include_sensitive_fields include_hidden_fields include_editable_data_model]
{id ms/PositiveInt
include_sensitive_fields [:maybe ms/BooleanValue]
include_hidden_fields [:maybe ms/BooleanValue]
include_editable_data_model [:maybe ms/BooleanValue]}
(fetch-query-metadata (t2/select-one Table :id id) {:include-sensitive-fields? include_sensitive_fields
:include-hidden-fields? include_hidden_fields
:include-editable-data-model? include_editable_data_model})) |
Return a sequence of 'virtual' fields metadata for the 'virtual' table for a Card in the Saved Questions 'virtual' database. | (defn- card-result-metadata->virtual-fields
[card-id database-id metadata]
(let [db (t2/select-one Database :id database-id)
underlying (m/index-by :id (when-let [ids (seq (keep :id metadata))]
(t2/select Field :id [:in ids])))
fields (for [{col-id :id :as col} metadata]
(-> col
(update :base_type keyword)
(merge (select-keys (underlying col-id)
[:semantic_type :fk_target_field_id :has_field_values]))
(assoc
:table_id (str "card__" card-id)
:id (or col-id
;; TODO -- what????
[:field (:name col) {:base-type (or (:base_type col) :type/*)}])
;; Assoc semantic_type at least temprorarily. We need the correct semantic type in place to make decisions
;; about what kind of dimension options should be added. PK/FK values will be removed after we've added
;; the dimension options
:semantic_type (keyword (:semantic_type col)))
(assoc-field-dimension-options db)))
field->annotated (let [with-ids (filter (comp number? :id) fields)]
(zipmap with-ids (t2/hydrate with-ids [:target :has_field_values] :has_field_values)))]
(map #(field->annotated % %) fields))) |
Schema name to use for the saved questions virtual database for Cards that are in the root collection (i.e., not in any collection). | (defn root-collection-schema-name [] "Everything else") |
Return metadata for a 'virtual' table for a | (defn card->virtual-table
[{:keys [database_id] :as card} & {:keys [include-fields?]}]
;; if collection isn't already hydrated then do so
(let [card (t2/hydrate card :collection)]
(cond-> {:id (str "card__" (u/the-id card))
:db_id (:database_id card)
:display_name (:name card)
:schema (get-in card [:collection :name] (root-collection-schema-name))
:moderated_status (:moderated_status card)
:description (:description card)}
include-fields? (assoc :fields (card-result-metadata->virtual-fields (u/the-id card)
database_id
(:result_metadata card)))))) |
This method clears the semantic_type attribute for PK/FK fields of nested queries. Those fields having a semantic type confuses the frontend and it can really used in the same way | (defn- remove-nested-pk-fk-semantic-types
[{:keys [fields] :as metadata-response}]
(assoc metadata-response :fields (for [{:keys [semantic_type id] :as field} fields]
(if (and (or (isa? semantic_type :type/PK)
(isa? semantic_type :type/FK))
;; if they have a user entered id let it stay
(or (nil? id)
(not (number? id))))
(assoc field :semantic_type nil)
field)))) |
/card_:id/querymetadata | (api/defendpoint GET
"Return metadata for the 'virtual' table for a Card."
[id]
{id ms/PositiveInt}
(let [{:keys [database_id] :as card} (api/check-404
(t2/select-one [Card :id :dataset_query :result_metadata :name :description
:collection_id :database_id]
:id id))
moderated-status (->> (mdb.query/query {:select [:status]
:from [:moderation_review]
:where [:and
[:= :moderated_item_type "card"]
[:= :moderated_item_id id]
[:= :most_recent true]]
:order-by [[:id :desc]]
:limit 1}
:id id)
first :status)
db (t2/select-one Database :id database_id)]
(-> (assoc card :moderated_status moderated-status)
api/read-check
(card->virtual-table :include-fields? true)
(assoc-dimension-options db)
remove-nested-pk-fk-semantic-types))) |
/card__:id/fks | (api/defendpoint GET
"Return FK info for the 'virtual' table for a Card. This is always empty, so this endpoint
serves mainly as a placeholder to avoid having to change anything on the frontend."
[id]
{id ms/PositiveInt}
[]) ; return empty array |
/:id/fks | (api/defendpoint GET
"Get all foreign keys whose destination is a `Field` that belongs to this `Table`."
[id]
{id ms/PositiveInt}
(api/read-check Table id)
(when-let [field-ids (seq (t2/select-pks-set Field, :table_id id, :visibility_type [:not= "retired"], :active true))]
(for [origin-field (t2/select Field, :fk_target_field_id [:in field-ids], :active true)]
;; it's silly to be hydrating some of these tables/dbs
{:relationship :Mt1
:origin_id (:id origin-field)
:origin (t2/hydrate origin-field [:table :db])
:destination_id (:fk_target_field_id origin-field)
:destination (t2/hydrate (t2/select-one Field :id (:fk_target_field_id origin-field)) :table)}))) |
/:id/rescan_values | (api/defendpoint POST
"Manually trigger an update for the FieldValues for the Fields belonging to this Table. Only applies to Fields that
are eligible for FieldValues."
[id]
{id ms/PositiveInt}
(let [table (api/write-check (t2/select-one Table :id id))]
(events/publish-event! :event/table-manual-scan {:object table :user-id api/*current-user-id*})
;; Override *current-user-permissions-set* so that permission checks pass during sync. If a user has DB detail perms
;; but no data perms, they should stll be able to trigger a sync of field values. This is fine because we don't
;; return any actual field values from this API. (#21764)
(binding [api/*current-user-permissions-set* (atom #{"/"})]
;; async so as not to block the UI
(sync.concurrent/submit-task
(fn []
(sync.field-values/update-field-values-for-table! table))))
{:status :success})) |
/:id/discard_values | (api/defendpoint POST
"Discard the FieldValues belonging to the Fields in this Table. Only applies to fields that have FieldValues. If
this Table's Database is set up to automatically sync FieldValues, they will be recreated during the next cycle."
[id]
{id ms/PositiveInt}
(api/write-check (t2/select-one Table :id id))
(when-let [field-ids (t2/select-pks-set Field :table_id id)]
(t2/delete! (t2/table-name FieldValues) :field_id [:in field-ids]))
{:status :success}) |
/:id/related | (api/defendpoint GET
"Return related entities."
[id]
{id ms/PositiveInt}
(-> (t2/select-one Table :id id) api/read-check related/related)) |
/:id/fields/order | (api/defendpoint PUT
"Reorder fields"
[id :as {field_order :body}]
{id ms/PositiveInt
field_order [:sequential ms/PositiveInt]}
(-> (t2/select-one Table :id id) api/write-check (table/custom-order-fields! field_order))) |
This helper function exists to make testing the POST /api/table/:id/append-csv endpoint easier. | (mu/defn ^:private append-csv!
[{:keys [id file]}
:- [:map
[:id ms/PositiveInt]
[:file (ms/InstanceOfClass java.io.File)]]]
(try
(let [model (upload/append-csv! {:table-id id
:file file})]
{:status 200
:body (:id model)})
(catch Throwable e
{:status (or (-> e ex-data :status-code)
500)
:body {:message (or (ex-message e)
(tru "There was an error uploading the file"))}})
(finally (io/delete-file file :silently)))) |
/:id/append-csv | (api/defendpoint ^:multipart POST
"Inserts the rows of an uploaded CSV file into the table identified by `:id`. The table must have been created by uploading a CSV file."
[id :as {raw-params :params}]
{id ms/PositiveInt}
(append-csv! {:id id, :file (get-in raw-params ["file" :tempfile])})) |
(api/define-routes) | |
/api/task endpoints | (ns metabase.api.task (:require [compojure.core :refer [GET]] [metabase.api.common :as api] [metabase.api.common.validation :as validation] [metabase.models.task-history :as task-history :refer [TaskHistory]] [metabase.server.middleware.offset-paging :as mw.offset-paging] [metabase.task :as task] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
/ | (api/defendpoint GET
"Fetch a list of recent tasks stored as Task History"
[]
(validation/check-has-application-permission :monitoring)
{:total (t2/count TaskHistory)
:limit mw.offset-paging/*limit*
:offset mw.offset-paging/*offset*
:data (task-history/all mw.offset-paging/*limit* mw.offset-paging/*offset*)}) |
/:id | (api/defendpoint GET
"Get `TaskHistory` entry with ID."
[id]
{id ms/PositiveInt}
(api/check-404 (api/read-check TaskHistory id))) |
/info | (api/defendpoint GET "Return raw data about all scheduled tasks (i.e., Quartz Jobs and Triggers)." [] (validation/check-has-application-permission :monitoring) (task/scheduler-info)) |
(api/define-routes) | |
Endpoints for testing. | (ns metabase.api.testing (:require [clojure.java.jdbc :as jdbc] [clojure.string :as str] [compojure.core :refer [POST]] [metabase.api.common :as api] [metabase.config :as config] [metabase.db.connection :as mdb.connection] [metabase.db.setup :as mdb.setup] [metabase.util.files :as u.files] [metabase.util.log :as log] [metabase.util.malli.schema :as ms]) (:import (com.mchange.v2.c3p0 PoolBackedDataSource) (java.util.concurrent.locks ReentrantReadWriteLock))) |
(set! *warn-on-reflection* true) | |
EVERYTHING BELOW IS FOR H2 ONLY. | |
(defn- assert-h2 [app-db]
(assert (= (:db-type app-db) :h2)
"Snapshot/restore only works for :h2 application databases.")) | |
(defn- snapshot-path-for-name
^String [snapshot-name]
(let [path (u.files/get-path "e2e" "snapshots"
(str (str/replace (name snapshot-name) #"\W" "_") ".sql"))]
(str (.toAbsolutePath path)))) | |
SAVE | |
(defn- save-snapshot! [snapshot-name]
(assert-h2 mdb.connection/*application-db*)
(let [path (snapshot-path-for-name snapshot-name)]
(log/infof "Saving snapshot to %s" path)
(jdbc/query {:datasource mdb.connection/*application-db*} ["SCRIPT TO ?" path]))
:ok) | |
/snapshot/:name | (api/defendpoint POST
"Snapshot the database for testing purposes."
[name]
{name ms/NonBlankString}
(save-snapshot! name)
nil) |
RESTORE | |
Immediately destroy all open connections in the app DB connection pool. | (defn- reset-app-db-connection-pool!
[]
(let [{:keys [data-source]} mdb.connection/*application-db*]
(when (instance? PoolBackedDataSource data-source)
(log/info "Destroying application database connection pool")
(.hardReset ^PoolBackedDataSource data-source)))) |
Drop all objects in the application DB, then reload everything from the SQL dump at | (defn- restore-app-db-from-snapshot!
[^String snapshot-path]
(log/infof "Restoring snapshot from %s" snapshot-path)
(api/check-404 (.exists (java.io.File. snapshot-path)))
(with-open [conn (.getConnection mdb.connection/*application-db*)]
(doseq [sql-args [["SET LOCK_TIMEOUT 180000"]
["DROP ALL OBJECTS"]
["RUNSCRIPT FROM ?" snapshot-path]]]
(jdbc/execute! {:connection conn} sql-args))
;; We've found a delightful bug in H2 where if you:
;; - create a table, then
;; - create a view based on the table, then
;; - modify the original table, then
;; - generate a snapshot
;; the generated snapshot has the `CREATE VIEW` *before* the `CREATE TABLE`. This results in a view that can't be
;; queried successfully until it is recompiled. Our workaround is to recompile ALL views immediately after we
;; restore the app DB from a snapshot. Bug report is here: https://github.com/h2database/h2database/issues/3942
(doseq [table-name
(->> (jdbc/query {:connection conn} ["SELECT table_name FROM information_schema.views WHERE table_schema=?" "PUBLIC"])
(map :table_name))]
;; parameterization doesn't work with view names. If someone maliciously named a table, this is bad. On the
;; other hand, this is not running in prod and you already had to have enough access to maliciously name the
;; table, so this is probably safe enough.
(jdbc/execute! {:connection conn} (format "ALTER VIEW %s RECOMPILE" table-name))))
;; don't know why this happens but when I try to test things locally with `yarn-test-cypress-open-no-backend` and a
;; backend server started with `dev/start!` the snapshots are always missing columms added by DB migrations. So let's
;; just check and make sure it's fully up to date in this scenario. Not doing this outside of dev because it seems to
;; work fine for whatever reason normally and we don't want tests taking 5 million years to run because we're wasting
;; a bunch of time initializing Liquibase and checking for unrun migrations for every test when we don't need to. --
;; Cam
(when config/is-dev?
(mdb.setup/migrate! (mdb.connection/db-type) mdb.connection/*application-db* :up))) |
Increment the [[mdb.connection/unique-identifier]] for the Metabase application DB. This effectively flushes all caches using it as a key (including things using [[mdb.connection/memoize-for-application-db]]) such as the Settings cache. | (defn- increment-app-db-unique-indentifier! [] (alter-var-root #'mdb.connection/*application-db* assoc :id (swap! mdb.connection/application-db-counter inc))) |
(defn- restore-snapshot! [snapshot-name]
(assert-h2 mdb.connection/*application-db*)
(let [path (snapshot-path-for-name snapshot-name)
^ReentrantReadWriteLock lock (:lock mdb.connection/*application-db*)]
;; acquire the application DB WRITE LOCK which will prevent any other threads from getting any new connections until
;; we release it.
(try
(.. lock writeLock lock)
(reset-app-db-connection-pool!)
(restore-app-db-from-snapshot! path)
(increment-app-db-unique-indentifier!)
(finally
(.. lock writeLock unlock))))
:ok) | |
/restore/:name | (api/defendpoint POST
"Restore a database snapshot for testing purposes."
[name]
{name ms/NonBlankString}
(restore-snapshot! name)
nil) |
/echo | (api/defendpoint POST
[fail :as {:keys [body]}]
{fail ms/BooleanValue}
(if fail
{:status 400
:body {:error-code "oops"}}
{:status 200
:body body})) |
(api/define-routes) | |
| (ns metabase.api.tiles (:require [cheshire.core :as json] [clojure.set :as set] [compojure.core :refer [GET]] [metabase.api.common :as api] [metabase.mbql.normalize :as mbql.normalize] [metabase.mbql.util :as mbql.u] [metabase.query-processor :as qp] [metabase.query-processor.util :as qp.util] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.malli.schema :as ms]) (:import (java.awt Color) (java.awt.image BufferedImage) (java.io ByteArrayOutputStream) (javax.imageio ImageIO))) |
(set! *warn-on-reflection* true) | |
--------------------------------------------------- CONSTANTS ---------------------------------------------------- | |
Limit for number of pins to query for per tile. | (def ^:private ^:const tile-size 256.0) (def ^:private ^:const pixel-origin (float (/ tile-size 2))) (def ^:private ^:const pin-size 6) (def ^:private ^:const pixels-per-lon-degree (float (/ tile-size 360))) (def ^:private ^:const pixels-per-lon-radian (float (/ tile-size (* 2 Math/PI)))) (def ^:private ^:const tile-coordinate-limit 2000) |
---------------------------------------------------- UTIL FNS ---------------------------------------------------- | |
(defn- degrees->radians ^double [^double degrees] (* degrees (/ Math/PI 180.0))) | |
(defn- radians->degrees ^double [^double radians] (/ radians (/ Math/PI 180.0))) | |
--------------------------------------------------- QUERY FNS ---------------------------------------------------- | |
Get the latitude & longitude of the upper left corner of a given tile. | (defn- x+y+zoom->lat-lon
[^double x, ^double y, ^long zoom]
(let [num-tiles (bit-shift-left 1 zoom)
corner-x (/ (* x tile-size) num-tiles)
corner-y (/ (* y tile-size) num-tiles)
lon (/ (- corner-x pixel-origin) pixels-per-lon-degree)
lat-radians (/ (- corner-y pixel-origin) (* pixels-per-lon-radian -1))
lat (radians->degrees (- (* 2 (Math/atan (Math/exp lat-radians)))
(/ Math/PI 2)))]
{:lat lat, :lon lon})) |
Add an | (defn- query-with-inside-filter
[details lat-field lon-field x y zoom]
(let [top-left (x+y+zoom->lat-lon x y zoom)
bottom-right (x+y+zoom->lat-lon (inc x) (inc y) zoom)
inside-filter [:inside
lat-field
lon-field
(top-left :lat)
(top-left :lon)
(bottom-right :lat)
(bottom-right :lon)]]
(update details :filter mbql.u/combine-filter-clauses inside-filter))) |
--------------------------------------------------- RENDERING ---------------------------------------------------- | |
(defn- create-tile ^BufferedImage [zoom points]
(let [num-tiles (bit-shift-left 1 zoom)
tile (BufferedImage. tile-size tile-size (BufferedImage/TYPE_INT_ARGB))
graphics (.getGraphics tile)
color-blue (new Color 76 157 230)
color-white (Color/white)]
(try
(doseq [[^double lat, ^double lon] points]
(let [sin-y (-> (Math/sin (degrees->radians lat))
(Math/max -0.9999) ; bound sin-y between -0.9999 and 0.9999 (why ?))
(Math/min 0.9999))
point {:x (+ pixel-origin
(* lon pixels-per-lon-degree))
:y (+ pixel-origin
(* 0.5
(Math/log (/ (+ 1 sin-y)
(- 1 sin-y)))
(* pixels-per-lon-radian -1.0)))} ; huh?
map-pixel {:x (int (Math/floor (* (point :x) num-tiles)))
:y (int (Math/floor (* (point :y) num-tiles)))}
tile-pixel {:x (mod (map-pixel :x) tile-size)
:y (mod (map-pixel :y) tile-size)}]
;; now draw a "pin" at the given tile pixel location
(.setColor graphics color-white)
(.fillRect graphics (tile-pixel :x) (tile-pixel :y) pin-size pin-size)
(.setColor graphics color-blue)
(.fillRect graphics (inc (tile-pixel :x)) (inc (tile-pixel :y)) (- pin-size 2) (- pin-size 2))))
(catch Throwable e
(.printStackTrace e))
(finally
(.dispose graphics)))
tile)) | |
(defn- tile->byte-array ^bytes [^BufferedImage tile]
(let [output-stream (ByteArrayOutputStream.)]
(try
(when-not (ImageIO/write tile "png" output-stream) ; returns `true` if successful -- see JavaDoc
(throw (Exception. (tru "No appropriate image writer found!"))))
(.flush output-stream)
(.toByteArray output-stream)
(catch Throwable _e
(byte-array 0)) ; return empty byte array if we fail for some reason
(finally
(u/ignore-exceptions
(.close output-stream)))))) | |
Adjust native queries to be an mbql from a source query so we can add the filter clause. | (defn- native->source-query
[query]
(if (contains? query :native)
(let [native (set/rename-keys (:native query) {:query :native})]
{:database (:database query)
:type :query
:query {:source-query native}})
query)) |
---------------------------------------------------- ENDPOINT ---------------------------------------------------- | |
Parse a string into an integer if it can be otherwise return the string. Intended to determine whether something is a field id or a field name. | (defn- int-or-string
[x]
(if (re-matches #"\d+" x)
(Integer/parseInt x)
x)) |
Makes a field reference for | (defn- field-ref
[id-or-name]
(let [id-or-name' (int-or-string id-or-name)]
[:field id-or-name' (when (string? id-or-name') {:base-type :type/Float})])) |
Transform a card's query into a query finding coordinates in a particular region.
| (defn- query->tiles-query
[query {:keys [zoom x y lat-field lon-field]}]
(-> query
native->source-query
(update :query query-with-inside-filter
lat-field lon-field
x y zoom)
(assoc-in [:query :fields] [lat-field lon-field])
(assoc-in [:query :limit] tile-coordinate-limit)
(assoc :async? false))) |
/:zoom/:x/:y/:lat-field/:lon-field TODO - this can be reworked to be TODO - this should reduce results from the QP in a streaming fashion instead of requiring them all to be in memory at the same time | (api/defendpoint GET
"This endpoints provides an image with the appropriate pins rendered given a MBQL `query` (passed as a GET query
string param). We evaluate the query and find the set of lat/lon pairs which are relevant and then render the
appropriate ones. It's expected that to render a full map view several calls will be made to this endpoint in
parallel."
[zoom x y lat-field lon-field query]
{zoom ms/Int
x ms/Int
y ms/Int
lat-field :string
lon-field :string
query ms/JSONString}
(let [lat-field-ref (field-ref lat-field)
lon-field-ref (field-ref lon-field)
query
(mbql.normalize/normalize (json/parse-string query keyword))
updated-query (query->tiles-query query {:zoom zoom :x x :y y
:lat-field lat-field-ref
:lon-field lon-field-ref})
{:keys [status], {:keys [rows cols]} :data, :as result}
(qp/process-query-and-save-execution! updated-query
{:executed-by api/*current-user-id*
:context :map-tiles})
lat-key (qp.util/field-ref->key lat-field-ref)
lon-key (qp.util/field-ref->key lon-field-ref)
find-fn (fn [lat-or-lon-key]
(first (keep-indexed
(fn [idx col] (when (= (qp.util/field-ref->key (:field_ref col)) lat-or-lon-key) idx))
cols)))
lat-idx (find-fn lat-key)
lon-idx (find-fn lon-key)
points (for [row rows]
[(nth row lat-idx) (nth row lon-idx)])]
(if (= status :completed)
{:status 200
:headers {"Content-Type" "image/png"}
:body (tile->byte-array (create-tile zoom points))}
(throw (ex-info (tru "Query failed")
;; `result` might be a `core.async` channel or something we're not expecting
(assoc (when (map? result) result) :status-code 400)))))) |
(api/define-routes) | |
/api/timeline endpoints. | (ns metabase.api.timeline
(:require
[compojure.core :refer [DELETE GET POST PUT]]
[metabase.api.common :as api]
[metabase.models.collection :as collection]
[metabase.models.collection.root :as collection.root]
[metabase.models.timeline :as timeline :refer [Timeline]]
[metabase.models.timeline-event
:as timeline-event
:refer [TimelineEvent]]
[metabase.util :as u]
[metabase.util.date-2 :as u.date]
[metabase.util.malli.schema :as ms]
[toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
Events Query Parameters Schema | (def Include [:enum "events"]) |
/ | (api/defendpoint POST
"Create a new [[Timeline]]."
[:as {{:keys [name default description icon collection_id archived], :as body} :body}]
{name ms/NonBlankString
default [:maybe :boolean]
description [:maybe :string]
icon [:maybe timeline-event/Icon]
collection_id [:maybe ms/PositiveInt]
archived [:maybe :boolean]}
(collection/check-write-perms-for-collection collection_id)
(let [tl (merge
body
{:creator_id api/*current-user-id*}
(when-not icon
{:icon timeline-event/default-icon}))]
(first (t2/insert-returning-instances! Timeline tl)))) |
/ | (api/defendpoint GET
"Fetch a list of [[Timelines]]. Can include `archived=true` to return archived timelines."
[include archived]
{include [:maybe Include]
archived [:maybe ms/BooleanString]}
(let [archived? (Boolean/parseBoolean archived)
timelines (->> (t2/select Timeline
{:where [:and
[:= :archived archived?]
(collection/visible-collection-ids->honeysql-filter-clause
(collection/permissions-set->visible-collection-ids @api/*current-user-permissions-set*))]
:order-by [[:%lower.name :asc]]})
(map collection.root/hydrate-root-collection))]
(cond->> (t2/hydrate timelines :creator [:collection :can_write])
(= include "events")
(map #(timeline-event/include-events-singular % {:events/all? archived?}))))) |
/:id | (api/defendpoint GET
"Fetch the [[Timeline]] with `id`. Include `include=events` to unarchived events included on the timeline. Add
`archived=true` to return all events on the timeline, both archived and unarchived."
[id include archived start end]
{id ms/PositiveInt
include [:maybe Include]
archived [:maybe ms/BooleanString]
start [:maybe ms/TemporalString]
end [:maybe ms/TemporalString]}
(let [archived? (Boolean/parseBoolean archived)
timeline (api/read-check (t2/select-one Timeline :id id))]
(cond-> (t2/hydrate timeline :creator [:collection :can_write])
;; `collection_id` `nil` means we need to assoc 'root' collection
;; because hydrate `:collection` needs a proper `:id` to work.
(nil? (:collection_id timeline))
collection.root/hydrate-root-collection
(= include "events")
(timeline-event/include-events-singular {:events/all? archived?
:events/start (when start (u.date/parse start))
:events/end (when end (u.date/parse end))})))) |
/:id | (api/defendpoint PUT
"Update the [[Timeline]] with `id`. Returns the timeline without events. Archiving a timeline will archive all of the
events in that timeline."
[id :as {{:keys [name default description icon collection_id archived] :as timeline-updates} :body}]
{id ms/PositiveInt
name [:maybe ms/NonBlankString]
default [:maybe :boolean]
description [:maybe :string]
icon [:maybe timeline-event/Icon]
collection_id [:maybe ms/PositiveInt]
archived [:maybe :boolean]}
(let [existing (api/write-check Timeline id)
current-archived (:archived (t2/select-one Timeline :id id))]
(collection/check-allowed-to-change-collection existing timeline-updates)
(t2/update! Timeline id
(u/select-keys-when timeline-updates
:present #{:description :icon :collection_id :default :archived}
:non-nil #{:name}))
(when (and (some? archived) (not= current-archived archived))
(t2/update! TimelineEvent {:timeline_id id} {:archived archived}))
(t2/hydrate (t2/select-one Timeline :id id) :creator [:collection :can_write]))) |
/:id | (api/defendpoint DELETE
"Delete a [[Timeline]]. Will cascade delete its events as well."
[id]
{id ms/PositiveInt}
(api/write-check Timeline id)
(t2/delete! Timeline :id id)
api/generic-204-no-content) |
(api/define-routes) | |
/api/timeline-event endpoints. | (ns metabase.api.timeline-event
(:require
[compojure.core :refer [DELETE GET POST PUT]]
[metabase.analytics.snowplow :as snowplow]
[metabase.api.common :as api]
[metabase.models.collection :as collection]
[metabase.models.timeline :as timeline :refer [Timeline]]
[metabase.models.timeline-event
:as timeline-event
:refer [TimelineEvent]]
[metabase.util :as u]
[metabase.util.date-2 :as u.date]
[metabase.util.i18n :refer [tru]]
[metabase.util.malli.schema :as ms]
[toucan2.core :as t2])) |
/ | (api/defendpoint POST
"Create a new [[TimelineEvent]]."
[:as {{:keys [name description timestamp time_matters timezone icon timeline_id source question_id archived] :as body} :body}]
{name ms/NonBlankString
description [:maybe :string]
timestamp ms/TemporalString
time_matters [:maybe :boolean]
timezone :string
icon [:maybe timeline-event/Icon]
timeline_id ms/PositiveInt
source [:maybe timeline-event/Source]
question_id [:maybe ms/PositiveInt]
archived [:maybe :boolean]}
;; deliberately not using api/check-404 so we can have a useful error message.
(let [timeline (t2/select-one Timeline :id timeline_id)]
(when-not timeline
(throw (ex-info (tru "Timeline with id {0} not found" timeline_id)
{:status-code 404})))
(collection/check-write-perms-for-collection (:collection_id timeline))
;; todo: revision system
(let [parsed (if (nil? timestamp)
(throw (ex-info (tru "Timestamp cannot be null") {:status-code 400}))
(u.date/parse timestamp))
tl-event (merge (dissoc body :source :question_id)
{:creator_id api/*current-user-id*
:timestamp parsed}
(when-not icon
{:icon (t2/select-one-fn :icon Timeline :id timeline_id)}))]
(snowplow/track-event! ::snowplow/new-event-created
api/*current-user-id*
(cond-> {:time_matters time_matters
:collection_id (:collection_id timeline)}
(boolean source) (assoc :source source)
(boolean question_id) (assoc :question_id question_id)))
(first (t2/insert-returning-instances! TimelineEvent tl-event))))) |
/:id | (api/defendpoint GET
"Fetch the [[TimelineEvent]] with `id`."
[id]
{id ms/PositiveInt}
(api/read-check TimelineEvent id)) |
/:id | (api/defendpoint PUT
"Update a [[TimelineEvent]]."
[id :as {{:keys [name description timestamp time_matters timezone icon timeline_id archived]
:as timeline-event-updates} :body}]
{id ms/PositiveInt
name [:maybe ms/NonBlankString]
description [:maybe :string]
timestamp [:maybe ms/TemporalString]
time_matters [:maybe :boolean]
timezone [:maybe :string]
icon [:maybe timeline-event/Icon]
timeline_id [:maybe ms/PositiveInt]
archived [:maybe :boolean]}
(let [existing (api/write-check TimelineEvent id)
timeline-event-updates (cond-> timeline-event-updates
(boolean timestamp) (update :timestamp u.date/parse))]
(collection/check-allowed-to-change-collection existing timeline-event-updates)
;; todo: if we accept a new timestamp, must we require a timezone? gut says yes?
(t2/update! TimelineEvent id
(u/select-keys-when timeline-event-updates
:present #{:description :timestamp :time_matters :timezone :icon :timeline_id :archived}
:non-nil #{:name}))
(t2/select-one TimelineEvent :id id))) |
/:id | (api/defendpoint DELETE
"Delete a [[TimelineEvent]]."
[id]
{id ms/PositiveInt}
(api/write-check TimelineEvent id)
(t2/delete! TimelineEvent :id id)
api/generic-204-no-content) |
(api/define-routes) | |
(ns metabase.api.transform (:require [compojure.core :refer [GET]] [medley.core :as m] [metabase.api.common :as api] [metabase.models.permissions :as perms] [metabase.transforms.core :as tf] [metabase.transforms.specs :as tf.specs] [metabase.util.malli.schema :as ms])) | |
/:db-id/:schema/:transform-name | (api/defendpoint GET
"Look up a database schema transform"
[db-id schema transform-name]
{db-id ms/PositiveInt
schema ms/NonBlankString
transform-name ms/NonBlankString}
(api/check-403 (perms/set-has-full-permissions? @api/*current-user-permissions-set*
(perms/data-perms-path db-id schema)))
(->> @tf.specs/transform-specs
(m/find-first (comp #{transform-name} :name))
(tf/apply-transform! db-id schema))) |
(api/define-routes) | |
/api/user endpoints | (ns metabase.api.user (:require [compojure.core :refer [DELETE GET POST PUT]] [honey.sql.helpers :as sql.helpers] [java-time.api :as t] [metabase.analytics.snowplow :as snowplow] [metabase.api.common :as api] [metabase.api.common.validation :as validation] [metabase.api.ldap :as api.ldap] [metabase.api.session :as api.session] [metabase.config :as config] [metabase.email.messages :as messages] [metabase.events :as events] [metabase.integrations.google :as google] [metabase.models.collection :as collection :refer [Collection]] [metabase.models.dashboard :refer [Dashboard]] [metabase.models.interface :as mi] [metabase.models.login-history :refer [LoginHistory]] [metabase.models.permissions-group :as perms-group] [metabase.models.setting :refer [defsetting]] [metabase.models.user :as user :refer [User]] [metabase.plugins.classloader :as classloader] [metabase.public-settings :as public-settings] [metabase.public-settings.premium-features :as premium-features] [metabase.server.middleware.offset-paging :as mw.offset-paging] [metabase.server.middleware.session :as mw.session] [metabase.server.request.util :as request.u] [metabase.util :as u] [metabase.util.i18n :refer [deferred-tru tru]] [metabase.util.malli.schema :as ms] [metabase.util.password :as u.password] [toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
(when config/ee-available?
(classloader/require 'metabase-enterprise.sandbox.api.util
'metabase-enterprise.advanced-permissions.common
'metabase-enterprise.advanced-permissions.models.permissions.group-manager)) | |
(defsetting user-visibility (deferred-tru "Note: Sandboxed users will never see suggestions.") :visibility :authenticated :feature :email-restrict-recipients :type :keyword :default :all :audit :raw-value) | |
Check that | (defn check-self-or-superuser
[user-id]
{:pre [(integer? user-id)]}
(api/check-403
(or
(= user-id api/*current-user-id*)
api/*is-superuser?*))) |
Check that | (defn check-not-internal-user
[user-id]
{:pre [(integer? user-id)]}
(api/check (not= user-id config/internal-mb-user-id)
[400 (tru "Not able to modify the internal user")])) |
(defn- fetch-user [& query-criteria] (apply t2/select-one (vec (cons User user/admin-or-self-visible-columns)) :type :personal query-criteria)) | |
(defn- maybe-set-user-permissions-groups! [user-or-id new-groups-or-ids]
(when (and new-groups-or-ids
(not (= (user/group-ids user-or-id)
(set (map u/the-id new-groups-or-ids)))))
(api/check-superuser)
(user/set-permissions-groups! user-or-id new-groups-or-ids))) | |
(defn- maybe-set-user-group-memberships!
[user-or-id new-user-group-memberships & [is-superuser?]]
(when new-user-group-memberships
;; if someone passed in both `:is_superuser` and `:group_ids`, make sure the whether the admin group is in group_ids
;; agrees with is_superuser -- don't want to have ambiguous behavior
(when (some? is-superuser?)
(api/checkp (= is-superuser? (contains? (set (map :id new-user-group-memberships)) (u/the-id (perms-group/admin))))
"is_superuser" (tru "Value of is_superuser must correspond to presence of Admin group ID in group_ids.")))
(if-let [f (and (premium-features/enable-advanced-permissions?)
(resolve 'metabase-enterprise.advanced-permissions.models.permissions.group-manager/set-user-group-memberships!))]
(f user-or-id new-user-group-memberships)
(maybe-set-user-permissions-groups! user-or-id (map :id new-user-group-memberships))))) | |
(defn- updated-user-name [user-before-update changes]
(let [[previous current] (map #(select-keys % [:first_name :last_name]) [user-before-update changes])
updated-names (merge previous current)]
(when (not= previous updated-names)
updated-names))) | |
(defn- maybe-update-user-personal-collection-name! [user-before-update changes]
;; If the user name is updated, we shall also update the personal collection name (if such collection exists).
(when-some [{:keys [first_name last_name]} (updated-user-name user-before-update changes)]
(when-some [collection (collection/user->existing-personal-collection (u/the-id user-before-update))]
(let [{email :email} user-before-update
new-collection-name (collection/format-personal-collection-name first_name last_name email :site)]
(when-not (= new-collection-name (:name collection))
(t2/update! Collection (:id collection) {:name new-collection-name})))))) | |
+----------------------------------------------------------------------------------------------------------------+ | Fetching Users -- GET /api/user, GET /api/user/current, GET /api/user/:id | +----------------------------------------------------------------------------------------------------------------+ | |
Figure out what This is to keep backwards compatibility with | (defn- status-clause
[status include_deactivated]
(if include_deactivated
nil
(case status
"all" nil
"deactivated" [:= :is_active false]
"active" [:= :is_active true]
[:= :is_active true]))) |
(defn- wildcard-query [query] (str "%" (u/lower-case-en query) "%")) | |
Honeysql clause to shove into user query if there's a query | (defn- query-clause [query] [:or [:like :%lower.first_name (wildcard-query query)] [:like :%lower.last_name (wildcard-query query)] [:like :%lower.email (wildcard-query query)]]) |
Columns of user table visible to current caller of API. | (defn- user-visible-columns [] (cond api/*is-superuser?* user/admin-or-self-visible-columns api/*is-group-manager?* user/group-manager-visible-columns :else user/non-admin-or-self-visible-columns)) |
Honeysql clauses for filtering on users - with a status, - with a query, - with a group_id, - with include_deactivated | (defn- user-clauses
[status query group_ids include_deactivated]
(cond-> {}
true (sql.helpers/where [:= :core_user.type "personal"])
true (sql.helpers/where (status-clause status include_deactivated))
;; don't send the internal user
(premium-features/sandboxed-or-impersonated-user?) (sql.helpers/where [:= :core_user.id api/*current-user-id*])
(some? query) (sql.helpers/where (query-clause query))
(some? group_ids) (sql.helpers/right-join
:permissions_group_membership
[:= :core_user.id :permissions_group_membership.user_id])
(some? group_ids) (sql.helpers/where
[:in :permissions_group_membership.group_id group_ids])
(some? mw.offset-paging/*limit*) (sql.helpers/limit mw.offset-paging/*limit*)
(some? mw.offset-paging/*offset*) (sql.helpers/offset mw.offset-paging/*offset*))) |
Given a where clause, return a clause that can be used to count. | (defn- filter-clauses-without-paging [clauses] (dissoc clauses :order-by :limit :offset)) |
Given a | (defn- group-ids-for-manager
[user-id]
(t2/select-fn-set
:group_id
:model/PermissionsGroupMembership
{:where [:and [:= :user_id user-id]
[:= :is_group_manager true]
[:not= :group_id (:id (perms-group/all-users))]]})) |
/ | (api/defendpoint GET
"Fetch a list of `Users` for admins or group managers.
By default returns only active users for admins and only active users within groups that the group manager is managing for group managers.
- If `status` is `deactivated`, include deactivated users only.
- If `status` is `all`, include all users (active and inactive).
- Also supports `include_deactivated`, which if true, is equivalent to `status=all`; If is false, is equivalent to `status=active`.
`status` and `include_deactivated` requires superuser permissions.
- `include_deactivated` is a legacy alias for `status` and will be removed in a future release, users are advised to use `status` for better support and flexibility.
If both params are passed, `status` takes precedence.
For users with segmented permissions, return only themselves.
Takes `limit`, `offset` for pagination.
Takes `query` for filtering on first name, last name, email.
Also takes `group_id`, which filters on group id."
[status query group_id include_deactivated]
{status [:maybe :string]
query [:maybe :string]
group_id [:maybe ms/PositiveInt]
include_deactivated [:maybe ms/BooleanString]}
(or
api/*is-superuser?*
(if group_id
(validation/check-manager-of-group group_id)
(validation/check-group-manager)))
(let [include_deactivated (Boolean/parseBoolean include_deactivated)
manager-group-ids (set (group-ids-for-manager api/*current-user-id*))
group-id-clause (cond
;; We know that the user is either admin or group manager of the given group_id (if it exists)
group_id [group_id]
;; Superuser can see all users, so don't filter by group ID
api/*is-superuser?* nil
;; otherwise, if the user is a group manager, only show them users in the groups they manage
api/*is-group-manager?* (vec manager-group-ids))
clauses (user-clauses status query group-id-clause include_deactivated)]
{:data (cond-> (t2/select
(vec (cons User (user-visible-columns)))
(cond-> clauses
(and (some? group_id) group-id-clause) (sql.helpers/order-by [:core_user.is_superuser :desc] [:is_group_manager :desc])
true (sql.helpers/order-by [:%lower.first_name :asc]
[:%lower.last_name :asc]
[:id :asc])))
;; For admins also include the IDs of Users' Personal Collections
api/*is-superuser?*
(t2/hydrate :personal_collection_id)
(or api/*is-superuser?*
api/*is-group-manager?*)
(t2/hydrate :group_ids)
;; if there is a group_id clause, make sure the list is deduped in case the same user is in multiple gropus
group-id-clause
distinct)
:total (-> (t2/query
(merge {:select [[[:count [:distinct :core_user.id]] :count]]
:from :core_user}
(filter-clauses-without-paging clauses)))
first
:count)
:limit mw.offset-paging/*limit*
:offset mw.offset-paging/*offset*})) |
Return a list of all user-ids in the same group with the user with id | (defn- same-groups-user-ids
[user-id]
(map :user_id
(t2/query {:select-distinct [:permissions_group_membership.user_id]
:from [:permissions_group_membership]
:where [:in :permissions_group_membership.group_id
;; get all the groups ids that the current user is in
{:select-distinct [:permissions_group_membership.group_id]
:from [:permissions_group_membership]
:where [:and [:= :permissions_group_membership.user_id user-id]
[:not= :permissions_group_membership.group_id (:id (perms-group/all-users))]]}]}))) |
/recipients | (api/defendpoint GET
"Fetch a list of `Users`. Returns only active users. Meant for non-admins unlike GET /api/user.
- If user-visibility is :all or the user is an admin, include all users.
- If user-visibility is :group, include only users in the same group (excluding the all users group).
- If user-visibility is :none or the user is sandboxed, include only themselves."
[]
(cond
(or (= :all (user-visibility)) api/*is-superuser?*)
(let [clauses (-> (user-clauses nil nil nil nil)
(sql.helpers/order-by [:%lower.last_name :asc] [:%lower.first_name :asc]))]
{:data (t2/select (vec (cons User (user-visible-columns))) clauses)
:total (t2/count :model/User (filter-clauses-without-paging clauses))
:limit mw.offset-paging/*limit*
:offset mw.offset-paging/*offset*})
(and (= :group (user-visibility)) (not (premium-features/sandboxed-or-impersonated-user?)))
(let [user-ids (same-groups-user-ids api/*current-user-id*)
clauses (cond-> (user-clauses nil nil nil nil)
(seq user-ids) (sql.helpers/where [:in :core_user.id user-ids])
true (sql.helpers/order-by [:%lower.last_name :asc] [:%lower.first_name :asc]))]
{:data (t2/select (vec (cons User (user-visible-columns))) clauses)
:total (t2/count :model/User (filter-clauses-without-paging clauses))
:limit mw.offset-paging/*limit*
:offset mw.offset-paging/*offset*})
:else
{:data [(fetch-user :id api/*current-user-id*)]
:total 1
:limit mw.offset-paging/*limit*
:offset mw.offset-paging/*offset*})) |
If | (defn- maybe-add-advanced-permissions
[user]
(if-let [with-advanced-permissions
(and (premium-features/enable-advanced-permissions?)
(resolve 'metabase-enterprise.advanced-permissions.common/with-advanced-permissions))]
(with-advanced-permissions user)
user)) |
Adds | (defn- maybe-add-sso-source
[{:keys [id] :as user}]
(if (premium-features/enable-any-sso?)
(assoc user :sso_source (t2/select-one-fn :sso_source User :id id))
user)) |
True when the user has permissions for at least one un-archived question and one un-archived dashboard. | (defn- add-has-question-and-dashboard
[user]
(let [coll-ids-filter (collection/visible-collection-ids->honeysql-filter-clause
:collection_id
(collection/permissions-set->visible-collection-ids @api/*current-user-permissions-set*))
perms-query {:where [:and
[:= :archived false]
coll-ids-filter]}]
(assoc user :has_question_and_dashboard (and (t2/exists? :model/Card perms-query)
(t2/exists? :model/Dashboard perms-query))))) |
Adds | (defn- add-first-login
[{:keys [id] :as user}]
(let [ts (or
(:timestamp (t2/select-one [LoginHistory :timestamp] :user_id id
{:order-by [[:timestamp :asc]]}))
(t/offset-date-time))]
(assoc user :first_login ts))) |
Adds custom homepage dashboard information to the current user. | (defn add-custom-homepage-info
[user]
(let [enabled? (public-settings/custom-homepage)
id (public-settings/custom-homepage-dashboard)
dash (t2/select-one Dashboard :id id)
valid? (and enabled? id (some? dash) (not (:archived dash)) (mi/can-read? dash))]
(assoc user
:custom_homepage (when valid? {:dashboard_id id})))) |
/current | (api/defendpoint GET
"Fetch the current `User`."
[]
(-> (api/check-404 @api/*current-user*)
(t2/hydrate :personal_collection_id :group_ids :is_installer :has_invited_second_user)
add-has-question-and-dashboard
add-first-login
maybe-add-advanced-permissions
maybe-add-sso-source
add-custom-homepage-info)) |
/:id | (api/defendpoint GET
"Fetch a `User`. You must be fetching yourself *or* be a superuser *or* a Group Manager."
[id]
{id ms/PositiveInt}
(try
(check-self-or-superuser id)
(catch clojure.lang.ExceptionInfo _e
(validation/check-group-manager)))
(check-not-internal-user id)
(-> (api/check-404 (fetch-user :id id, :is_active true))
(t2/hydrate :user_group_memberships))) |
+----------------------------------------------------------------------------------------------------------------+ | Creating a new User -- POST /api/user | +----------------------------------------------------------------------------------------------------------------+ | |
/ | (api/defendpoint POST
"Create a new `User`, return a 400 if the email address is already taken"
[:as {{:keys [first_name last_name email user_group_memberships login_attributes] :as body} :body}]
{first_name [:maybe ms/NonBlankString]
last_name [:maybe ms/NonBlankString]
email ms/Email
user_group_memberships [:maybe [:sequential user/UserGroupMembership]]
login_attributes [:maybe user/LoginAttributes]}
(api/check-superuser)
(api/checkp (not (t2/exists? User :%lower.email (u/lower-case-en email)))
"email" (tru "Email address already in use."))
(t2/with-transaction [_conn]
(let [new-user-id (u/the-id (user/create-and-invite-user!
(u/select-keys-when body
:non-nil [:first_name :last_name :email :password :login_attributes])
@api/*current-user*
false))]
(maybe-set-user-group-memberships! new-user-id user_group_memberships)
(snowplow/track-event! ::snowplow/invite-sent api/*current-user-id* {:invited-user-id new-user-id
:source "admin"})
(-> (fetch-user :id new-user-id)
(t2/hydrate :user_group_memberships))))) |
+----------------------------------------------------------------------------------------------------------------+ | Updating a User -- PUT /api/user/:id | +----------------------------------------------------------------------------------------------------------------+ | |
This predicate tests whether or not the user is allowed to update the email address associated with this account. | (defn- valid-email-update?
[{:keys [sso_source email]} maybe-new-email]
(or
;; Admin users can update
api/*is-superuser?*
;; If the email address didn't change, let it through
(= email maybe-new-email)
;; We should not allow a regular user to change their email address if they are a google/ldap user
(and
(not (= :google sso_source))
(not (= :ldap sso_source))))) |
This predicate tests whether or not the user is allowed to update the first/last name associated with this account. If the user is an SSO user, no name edits are allowed, but we accept if the new names are equal to the existing names. | (defn- valid-name-update?
[{:keys [sso_source] :as user} name-key new-name]
(or
(= (get user name-key) new-name)
(not sso_source))) |
/:id | (api/defendpoint PUT
"Update an existing, active `User`.
Self or superusers can update user info and groups.
Group Managers can only add/remove users from groups they are manager of."
[id :as {{:keys [email first_name last_name user_group_memberships
is_superuser is_group_manager login_attributes locale] :as body} :body}]
{id ms/PositiveInt
email [:maybe ms/Email]
first_name [:maybe ms/NonBlankString]
last_name [:maybe ms/NonBlankString]
user_group_memberships [:maybe [:sequential user/UserGroupMembership]]
is_superuser [:maybe :boolean]
is_group_manager [:maybe :boolean]
login_attributes [:maybe user/LoginAttributes]
locale [:maybe ms/ValidLocale]}
(try
(check-self-or-superuser id)
(catch clojure.lang.ExceptionInfo _e
(validation/check-group-manager)))
(check-not-internal-user id)
;; only allow updates if the specified account is active
(api/let-404 [user-before-update (fetch-user :id id, :is_active true)]
;; Google/LDAP non-admin users can't change their email to prevent account hijacking
(api/check-403 (valid-email-update? user-before-update email))
;; SSO users (JWT, SAML, LDAP, Google) can't change their first/last names
(when (contains? body :first_name)
(api/checkp (valid-name-update? user-before-update :first_name first_name)
"first_name" (tru "Editing first name is not allowed for SSO users.")))
(when (contains? body :last_name)
(api/checkp (valid-name-update? user-before-update :last_name last_name)
"last_name" (tru "Editing last name is not allowed for SSO users.")))
;; can't change email if it's already taken BY ANOTHER ACCOUNT
(api/checkp (not (t2/exists? User, :%lower.email (if email (u/lower-case-en email) email), :id [:not= id]))
"email" (tru "Email address already associated to another user."))
(t2/with-transaction [_conn]
;; only superuser or self can update user info
;; implicitly prevent group manager from updating users' info
(when (or (= id api/*current-user-id*)
api/*is-superuser?*)
(when-let [changes (not-empty
(u/select-keys-when body
:present (cond-> #{:first_name :last_name :locale}
api/*is-superuser?* (conj :login_attributes))
:non-nil (cond-> #{:email}
api/*is-superuser?* (conj :is_superuser))))]
(t2/update! User id changes)
(events/publish-event! :event/user-update {:object (t2/select-one User :id id)
:previous-object user-before-update
:user-id api/*current-user-id*}))
(maybe-update-user-personal-collection-name! user-before-update body))
(maybe-set-user-group-memberships! id user_group_memberships is_superuser)))
(-> (fetch-user :id id)
(t2/hydrate :user_group_memberships))) |
+----------------------------------------------------------------------------------------------------------------+ | Reactivating a User -- PUT /api/user/:id/reactivate | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- reactivate-user! [existing-user]
(t2/update! User (u/the-id existing-user)
{:is_active true
:is_superuser false
;; if the user orignally logged in via Google Auth/LDAP and it's no longer enabled, convert them into a regular user
;; (see metabase#3323)
:sso_source (case (:sso_source existing-user)
:google (when (google/google-auth-enabled) :google)
:ldap (when (api.ldap/ldap-enabled) :ldap)
(:sso_source existing-user))})
;; now return the existing user whether they were originally active or not
(fetch-user :id (u/the-id existing-user))) | |
/:id/reactivate | (api/defendpoint PUT
"Reactivate user at `:id`"
[id]
{id ms/PositiveInt}
(api/check-superuser)
(check-not-internal-user id)
(let [user (t2/select-one [:model/User :id :email :first_name :last_name :is_active :sso_source]
:type :personal
:id id)]
(api/check-404 user)
;; Can only reactivate inactive users
(api/check (not (:is_active user))
[400 {:message (tru "Not able to reactivate an active user")}])
(events/publish-event! :event/user-reactivated {:object user :user-id api/*current-user-id*})
(reactivate-user! (dissoc user [:email :first_name :last_name])))) |
+----------------------------------------------------------------------------------------------------------------+ | Updating a Password -- PUT /api/user/:id/password | +----------------------------------------------------------------------------------------------------------------+ | |
/:id/password | (api/defendpoint PUT
"Update a user's password."
[id :as {{:keys [password old_password]} :body, :as request}]
{id ms/PositiveInt
password ms/ValidPassword}
(check-self-or-superuser id)
(api/let-404 [user (t2/select-one [User :id :last_login :password_salt :password],
:id id,
:type :personal,
:is_active true)]
;; admins are allowed to reset anyone's password (in the admin people list) so no need to check the value of
;; `old_password` for them regular users have to know their password, however
(when-not api/*is-superuser?*
(api/checkp (u.password/bcrypt-verify (str (:password_salt user) old_password) (:password user))
"old_password"
(tru "Invalid password")))
(user/set-password! id password)
;; after a successful password update go ahead and offer the client a new session that they can use
(when (= id api/*current-user-id*)
(let [{session-uuid :id, :as session} (api.session/create-session! :password user (request.u/device-info request))
response {:success true
:session_id (str session-uuid)}]
(mw.session/set-session-cookies request response session (t/zoned-date-time (t/zone-id "GMT"))))))) |
+----------------------------------------------------------------------------------------------------------------+ | Deleting (Deactivating) a User -- DELETE /api/user/:id | +----------------------------------------------------------------------------------------------------------------+ | |
/:id | (api/defendpoint DELETE
"Disable a `User`. This does not remove the `User` from the DB, but instead disables their account."
[id]
{id ms/PositiveInt}
(api/check-superuser)
;; don't technically need to because the internal user is already 'deleted' (deactivated), but keeps the warnings consistent
(check-not-internal-user id)
(api/check-500
(when (pos? (t2/update! User id {:type :personal} {:is_active false}))
(events/publish-event! :event/user-deactivated {:object (t2/select-one User :id id) :user-id api/*current-user-id*})))
{:success true}) |
+----------------------------------------------------------------------------------------------------------------+ | Other Endpoints -- PUT /api/user/:id/qpnewb, POST /api/user/:id/send_invite | +----------------------------------------------------------------------------------------------------------------+ | |
/:id/modal/:modal TODO - This could be handled by PUT /api/user/:id, we don't need a separate endpoint | (api/defendpoint PUT
"Indicate that a user has been informed about the vast intricacies of 'the' Query Builder."
[id modal]
{id ms/PositiveInt}
(check-self-or-superuser id)
(check-not-internal-user id)
(let [k (or (get {"qbnewb" :is_qbnewb
"datasetnewb" :is_datasetnewb}
modal)
(throw (ex-info (tru "Unrecognized modal: {0}" modal)
{:modal modal
:allowable-modals #{"qbnewb" "datasetnewb"}})))]
(api/check-500 (pos? (t2/update! User id {:type :personal} {k false}))))
{:success true}) |
/:id/send_invite | (api/defendpoint POST
"Resend the user invite email for a given user."
[id]
{id ms/PositiveInt}
(api/check-superuser)
(check-not-internal-user id)
(when-let [user (t2/select-one User :id id, :is_active true, :type :personal)]
(let [reset-token (user/set-password-reset-token! id)
;; NOTE: the new user join url is just a password reset with an indicator that this is a first time user
join-url (str (user/form-password-reset-url reset-token) "#new")]
(messages/send-new-user-email! user @api/*current-user* join-url false)))
{:success true}) |
(api/define-routes) | |
Random utilty endpoints for things that don't belong anywhere else in particular, e.g. endpoints for certain admin page tasks. | (ns metabase.api.util (:require [compojure.core :refer [GET POST]] [crypto.random :as crypto-random] [metabase.analytics.prometheus :as prometheus] [metabase.analytics.stats :as stats] [metabase.api.common :as api] [metabase.api.common.validation :as validation] [metabase.logger :as logger] [metabase.troubleshooting :as troubleshooting] [metabase.util.malli.schema :as ms] [ring.util.response :as response])) |
/password_check | (api/defendpoint POST
"Endpoint that checks if the supplied password meets the currently configured password complexity rules."
[:as {{:keys [password]} :body}]
{password ms/ValidPassword} ;; if we pass the su/ValidPassword test we're g2g
{:valid true}) |
/logs | (api/defendpoint GET "Logs." [] (validation/check-has-application-permission :monitoring) (logger/messages)) |
/stats | (api/defendpoint GET "Anonymous usage stats. Endpoint for testing, and eventually exposing this to instance admins to let them see what is being phoned home." [] (validation/check-has-application-permission :monitoring) (stats/anonymous-usage-stats)) |
/random_token | (api/defendpoint GET
"Return a cryptographically secure random 32-byte token, encoded as a hexadecimal string.
Intended for use when creating a value for `embedding-secret-key`."
[]
{:token (crypto-random/hex 32)}) |
/bugreportdetails | (api/defendpoint GET
"Returns version and system information relevant to filing a bug report against Metabase."
[]
(validation/check-has-application-permission :monitoring)
{:system-info (troubleshooting/system-info)
:metabase-info (troubleshooting/metabase-info)}) |
/diagnosticinfo/connectionpool_info | (api/defendpoint GET
"Returns database connection pool info for the current Metabase instance."
[]
(validation/check-has-application-permission :monitoring)
(let [pool-info (prometheus/connection-pool-info)
headers {"Content-Disposition" "attachment; filename=\"connection_pool_info.json\""}]
(assoc (response/response {:connection-pools pool-info}) :headers headers, :status 200))) |
(api/define-routes) | |
(ns metabase.async.streaming-response (:require [cheshire.core :as json] [clojure.core.async :as a] [compojure.response] [metabase.async.streaming-response.thread-pool :as thread-pool] [metabase.async.util :as async.u] [metabase.server.protocols :as server.protocols] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [potemkin.types :as p.types] [pretty.core :as pretty] [ring.adapter.jetty9.common :as common] [ring.util.response :as response]) (:import (java.io BufferedWriter OutputStream OutputStreamWriter) (java.nio ByteBuffer) (java.nio.channels ClosedChannelException SocketChannel) (java.nio.charset StandardCharsets) (java.util.zip GZIPOutputStream) (jakarta.servlet AsyncContext) (jakarta.servlet.http HttpServletResponse) (org.eclipse.jetty.io EofException) (org.eclipse.jetty.server Request))) | |
(set! *warn-on-reflection* true) | |
(defn- write-to-output-stream!
([^OutputStream os x]
(if (int? x)
(.write os ^int x)
(.write os ^bytes x)))
([^OutputStream os ^bytes ba ^Integer offset ^Integer len]
(.write os ba offset len))) | |
(defn- ex-status-code [e]
(or (some #((some-fn :status-code :status) (ex-data %))
(take-while some? (iterate ex-cause e)))
500)) | |
(defn- format-exception [e] (assoc (Throwable->map e) :_status (ex-status-code e))) | |
Write an error to the output stream, formatting it nicely. Closes output stream afterwards. | (defn write-error!
[^OutputStream os obj]
(cond
(some #(instance? % obj)
[InterruptedException EofException])
(log/trace "Error is an InterruptedException or EofException, not writing to output stream")
(instance? Throwable obj)
(recur os (format-exception obj))
:else
(with-open [os os]
(log/trace (u/pprint-to-str (list 'write-error! obj)))
(try
(with-open [writer (BufferedWriter. (OutputStreamWriter. os StandardCharsets/UTF_8))]
(json/generate-stream obj writer))
(catch EofException _)
(catch Throwable e
(log/error e (trs "Error writing error to output stream") obj)))))) |
(defn- do-f* [f ^OutputStream os _finished-chan canceled-chan]
(try
(f os canceled-chan)
(catch EofException _
(a/>!! canceled-chan ::jetty-eof)
nil)
(catch InterruptedException _
(a/>!! canceled-chan ::thread-interrupted)
nil)
(catch Throwable e
(log/error e (trs "Caught unexpected Exception in streaming response body"))
(write-error! os e)
nil))) | |
Runs | (defn- do-f-async
[^AsyncContext async-context f ^OutputStream os finished-chan canceled-chan]
{:pre [(some? os)]}
(let [task (^:once fn* []
(try
(do-f* f os finished-chan canceled-chan)
(catch Throwable e
(log/error e (trs "bound-fn caught unexpected Exception"))
(a/>!! finished-chan :unexpected-error))
(finally
(a/>!! finished-chan (if (a/poll! canceled-chan)
:canceled
:completed))
(a/close! finished-chan)
(a/close! canceled-chan)
(.complete async-context))))]
(.submit (thread-pool/thread-pool) ^Runnable task)
nil)) |
Does the client accept GZIP-encoded responses?
| (defn- should-gzip-response?
[{{:strs [accept-encoding]} :headers}]
(some->> accept-encoding (re-find #"gzip|\*"))) |
(defn- output-stream-delay [gzip? ^HttpServletResponse response]
(if gzip?
(delay
(GZIPOutputStream. (.getOutputStream response) true))
(delay
(.getOutputStream response)))) | |
An OutputStream proxy that fetches the actual output stream by dereffing a delay (or other dereffable) before first use. | (defn- delay-output-stream
[dlay]
(proxy [OutputStream] []
(close []
(.close ^OutputStream @dlay))
(flush []
(.flush ^OutputStream @dlay))
(write
([x]
(write-to-output-stream! @dlay x))
([ba offset length]
(write-to-output-stream! @dlay ba offset length))))) |
How often to check whether the request was canceled by the client. | (def ^:private async-cancellation-poll-interval-ms 1000) |
Check whether the HTTP request has been canceled by the client. This function attempts to read a single byte from the underlying TCP socket; if the request is canceled, | (defn- canceled?
[^Request request]
(try
(let [^SocketChannel channel (.. request getHttpChannel getEndPoint getTransport)
buf (ByteBuffer/allocate 1)
status (.read channel buf)]
(log/tracef "Check cancelation status: .read returned %d" status)
(neg? status))
(catch InterruptedException _
false)
(catch ClosedChannelException _
true)
(catch Throwable e
(log/error e (trs "Error determining whether HTTP request was canceled"))
false))) |
How long to wait for the cancelation check to complete (it should usually complete immediately -- see above -- but if it doesn't, we don't want to block forever). | (def ^:private async-cancellation-poll-timeout-ms 1000) |
Starts an async loop that checks whether the client has canceled HTTP | (defn- start-async-cancel-loop!
[request finished-chan canceled-chan]
(a/go-loop []
(let [poll-timeout-chan (a/timeout async-cancellation-poll-interval-ms)
[_ port] (a/alts! [poll-timeout-chan finished-chan])]
(when (= port poll-timeout-chan)
(log/tracef "Checking cancelation status after waiting %s" (u/format-milliseconds async-cancellation-poll-interval-ms))
(let [canceled-status-chan (async.u/cancelable-thread (canceled? request))
status-timeout-chan (a/timeout async-cancellation-poll-timeout-ms)
[canceled? port] (a/alts! [finished-chan canceled-status-chan status-timeout-chan])]
;; if `canceled-status-chan` *wasn't* the first channel to return (i.e., we either timed out or the request
;; was completed) then close `canceled-status-chan` which will kill the underlying thread
(a/close! canceled-status-chan)
(when (= port status-timeout-chan)
(log/debug (trs "Check cancelation status timed out after {0}"
(u/format-milliseconds async-cancellation-poll-timeout-ms))))
(when (not= port finished-chan)
(if canceled?
(a/>! canceled-chan ::request-canceled)
(recur)))))))) |
(defn- respond
[{:keys [^HttpServletResponse response ^AsyncContext async-context request-map response-map request]}
f {:keys [content-type status headers], :as _options} finished-chan]
(let [canceled-chan (a/promise-chan)]
(try
(.setStatus response (or status 202))
(let [gzip? (should-gzip-response? request-map)
headers (cond-> (assoc (merge headers (:headers response-map)) "Content-Type" content-type)
gzip? (assoc "Content-Encoding" "gzip"))]
(#'common/set-headers response headers)
(let [output-stream-delay (output-stream-delay gzip? response)
delay-os (delay-output-stream output-stream-delay)]
(start-async-cancel-loop! request finished-chan canceled-chan)
(do-f-async async-context f delay-os finished-chan canceled-chan)))
(catch Throwable e
(log/error e (trs "Unexpected exception in do-f-async"))
(try
(.sendError response 500 (.getMessage e))
(catch Throwable e
(log/error e (trs "Unexpected exception writing error response"))))
(a/>!! finished-chan :unexpected-error)
(a/close! finished-chan)
(a/close! canceled-chan)
(.complete async-context))))) | |
(declare render) | |
(p.types/deftype+ StreamingResponse [f options donechan]
pretty/PrettyPrintable
(pretty [_]
(list (pretty/qualify-symbol-for-*ns* `->StreamingResponse) f options donechan))
server.protocols/Respond
(respond [_this context]
(respond context f options donechan))
;; sync responses only (in some cases?)
compojure.response/Renderable
(render [this request]
(render this (should-gzip-response? request)))
;; async responses only
compojure.response/Sendable
(send* [this request respond* _]
(respond* (compojure.response/render this request)))) | |
(defn- render [^StreamingResponse streaming-response gzip?]
(let [{:keys [headers content-type], :as options} (.options streaming-response)]
(assoc (response/response (if gzip?
(StreamingResponse. (.f streaming-response)
(assoc options :gzip? true)
(.donechan streaming-response))
streaming-response))
:headers (cond-> (assoc headers "Content-Type" content-type)
gzip? (assoc "Content-Encoding" "gzip"))
:status (or (:status options) 202)))) | |
Fetch a promise channel that will get a message when a | (defn finished-chan [^StreamingResponse response] (.donechan response)) |
Impl for | (defn streaming-response* [f options] (->StreamingResponse f options (a/promise-chan))) |
Create an API response that streams results to an Minimal example: (streaming-response {:content-type "application/json; charset=utf-8"} [os canceled-chan] (write-something-to-stream! os))
Current options:
| (defmacro streaming-response
{:style/indent 2, :arglists '([options [os-binding canceled-chan-binding] & body])}
[options [os-binding canceled-chan-binding :as bindings] & body]
{:pre [(= (count bindings) 2)]}
`(streaming-response* (bound-fn [~(vary-meta os-binding assoc :tag 'java.io.OutputStream) ~canceled-chan-binding] ~@body)
~options)) |
(ns metabase.async.streaming-response.thread-pool (:require [metabase.config :as config]) (:import (java.util.concurrent Executors ThreadPoolExecutor) (org.apache.commons.lang3.concurrent BasicThreadFactory$Builder))) | |
(set! *warn-on-reflection* true) | |
(def ^:private ^Long thread-pool-max-size
(or (config/config-int :mb-async-query-thread-pool-size)
(config/config-int :mb-jetty-maxthreads)
50)) | |
(defonce ^:private thread-pool*
(delay
(Executors/newFixedThreadPool thread-pool-max-size
(.build
(doto (BasicThreadFactory$Builder.)
(.namingPattern "streaming-response-thread-pool-%d")
;; Daemon threads do not block shutdown of the JVM
(.daemon true)))))) | |
Thread pool for asynchronously running streaming responses. | (defn thread-pool ^ThreadPoolExecutor [] @thread-pool*) |
The number of active streaming response threads. | (defn active-thread-count [] (.getActiveCount (thread-pool))) |
The number of queued streaming response threads. | (defn queued-thread-count [] (count (.getQueue (thread-pool)))) |
Utility functions for core.async-based async logic. | (ns metabase.async.util (:require [clojure.core.async :as a] [metabase.util.log :as log] [schema.core :as s]) (:import (clojure.core.async.impl.buffers PromiseBuffer) (clojure.core.async.impl.channels ManyToManyChannel) (java.util.concurrent ThreadPoolExecutor))) |
(set! *warn-on-reflection* true) | |
TODO - most of this stuff can be removed now that we have the new-new reducible/async QP implementation of early 2020. No longer needed | |
Is core.async | (defn promise-chan?
[chan]
(and (instance? ManyToManyChannel chan)
(instance? PromiseBuffer (.buf ^ManyToManyChannel chan)))) |
Schema for a core.async promise channel. | (def PromiseChan (s/constrained ManyToManyChannel promise-chan? "promise chan")) |
Like TODO -- this is used in literally one place only, [[metabase.api.public/run-query-for-card-with-id-async-run-fn]], so maybe we should consider getting rid of it. | (s/defn promise-pipe
[in-chan :- PromiseChan, out-chan :- PromiseChan]
(a/go
(let [[val port] (a/alts! [in-chan out-chan] :priority true)]
;; forward any result of `in-chan` to `out-chan`.
(when (and (= port in-chan)
(some? val))
(a/>! out-chan val))
;; Close both channels once either gets a result or is closed.
(a/close! in-chan)
(a/close! out-chan)))
nil) |
Exactly like 1) the result channel is a promise channel instead of a regular channel 2) Closing the result channel early will cancel the async thread call. | (defn cancelable-thread-call
[f]
;; create two channels:
;; * `done-chan` will always get closed immediately after `(f)` is finished
;; * `result-chan` will get the result of `(f)`, *after* `done-chan` is closed
(let [done-chan (a/promise-chan)
result-chan (a/promise-chan)
binds (clojure.lang.Var/getThreadBindingFrame)
f* (fn []
(clojure.lang.Var/resetThreadBindingFrame binds)
(let [result (try
(f)
(catch Throwable e
(log/trace e "cancelable-thread-call: caught exception in f")
e))]
(a/close! done-chan)
(when (some? result)
(a/>!! result-chan result)))
(a/close! result-chan))
futur (.submit ^ThreadPoolExecutor @#'a/thread-macro-executor ^Runnable f*)]
;; if `result-chan` gets a result/closed *before* `done-chan`, it means it was closed by the caller, so we should
;; cancel the thread running `f*`
(a/go
(let [[_ port] (a/alts! [done-chan result-chan] :priority true)]
(when (= port result-chan)
(log/trace "cancelable-thread-call: result channel closed before f finished; canceling thread")
(future-cancel futur))))
result-chan)) |
Exactly like 1) the result channel is a promise channel instead of a regular channel 2) Closing the result channel early will cancel the async thread call. | (defmacro cancelable-thread
{:style/indent 0}
[& body]
`(cancelable-thread-call (fn [] ~@body))) |
Generate "interesting" combinations of metrics, dimensions, and filters. In the Card templates provided the following key relationships: - dimension to dimension affinities - The groups of dimensions the might appear on the x-axis of a chart (breakouts). These generally a single dimension (e.g. time or category) but can be multiple (e.g. longitude and latitude) - dimension to metric affinities - Combinations of dimensions and metrics (e.g. profit metric over time dimension). This functionally adds breakouts to a metric. - metric to metric affinities - Combinations of metrics that belong together (e.g. Sum, Avg, Max, and Min of a field). The primary function in this ns, | (ns metabase.automagic-dashboards.combination
(:require
[clojure.math.combinatorics :as math.combo]
[clojure.string :as str]
[clojure.walk :as walk]
[medley.core :as m]
[metabase.automagic-dashboards.dashboard-templates :as dashboard-templates]
[metabase.automagic-dashboards.interesting :as interesting]
[metabase.automagic-dashboards.schema :as ads]
[metabase.automagic-dashboards.util :as magic.util]
[metabase.automagic-dashboards.visualization-macros :as visualization]
[metabase.driver :as driver]
[metabase.models.interface :as mi]
[metabase.query-processor.util :as qp.util]
[metabase.util :as u]
[metabase.util.i18n :as i18n]
[metabase.util.malli :as mu])) |
Add breakouts and filters to a query based on the breakout fields and filter clauses | (defn add-breakouts-and-filter
[query
breakout-fields
filter-clauses]
(cond->
(assoc query :breakout (mapv (partial interesting/->reference :mbql) breakout-fields))
(seq filter-clauses)
(assoc :filter (into [:and] filter-clauses)))) |
Given two seqs of types, return true of the types of the child types are satisfied by some permutation of the parent types. | (defn matching-types?
[parent-types child-types]
(true?
(when (= (count parent-types)
(count child-types))
(some
(fn [parent-types-permutation]
(when (->> (map isa? child-types parent-types-permutation)
(every? true?))
true))
(math.combo/permutations parent-types))))) |
Take a map with keys as sets of types and collection of types and return the map with only the type set keys that satisfy the types. | (defn filter-to-matching-types
[types->x types]
(into {} (filter #(matching-types? (first %) types)) types->x)) |
(comment
(filter-to-matching-types
{#{} :fail
#{:type/Number} :pass
#{:type/Integer} :pass
#{:type/CreationTimestamp} :fail}
#{:type/Integer})
) | |
Add the | (defn add-dataset-query
[{:keys [metric-definition] :as ground-metric-with-dimensions}
{{:keys [database]} :root :keys [source query-filter]}]
(let [source-table (if (->> source (mi/instance-of? :model/Table))
(-> source u/the-id)
(->> source u/the-id (str "card__")))]
(assoc ground-metric-with-dimensions
:dataset_query {:database database
:type :query
:query (cond-> (assoc metric-definition
:source-table source-table)
query-filter (assoc :filter query-filter))}))) |
(defn- instantiate-visualization
[[k v] dimensions metrics]
(let [dimension->name (comp vector :name dimensions)
metric->name (comp vector first :metric metrics)]
[k (-> v
(m/update-existing :map.latitude_column dimension->name)
(m/update-existing :map.longitude_column dimension->name)
(m/update-existing :graph.metrics metric->name)
(m/update-existing :graph.dimensions dimension->name))])) | |
Capitalize only the first letter in a given string. | (defn capitalize-first
[s]
(let [s (str s)]
(str (u/upper-case-en (subs s 0 1)) (subs s 1)))) |
(defn- fill-templates
[template-type {:keys [root tables]} bindings s]
(let [binding-fn (some-fn (merge {"this" (-> root
:entity
(assoc :full-name (:full-name root)))}
bindings)
(comp first #(magic.util/filter-tables % tables) dashboard-templates/->entity)
identity)]
(str/replace s #"\[\[(\w+)(?:\.([\w\-]+))?\]\]"
(fn [[_ identifier attribute]]
(let [entity (binding-fn identifier)
attribute (some-> attribute qp.util/normalize-token)]
(str (or (and (ifn? entity) (entity attribute))
(root attribute)
(interesting/->reference template-type entity)))))))) | |
(defn- instantiate-metadata
[x context available-metrics bindings]
(-> (walk/postwalk
(fn [form]
(if (i18n/localized-string? form)
(let [s (str form)
new-s (fill-templates :string context bindings s)]
(if (not= new-s s)
(capitalize-first new-s)
s))
form))
x)
(m/update-existing :visualization #(instantiate-visualization % bindings available-metrics)))) | |
Given grounded dimensions (name->field map) and card-dimensions (the :dimensions key) from a card, combine these into a single map. This is needed because the card dimensions may contain specializations such as breakout details for card visualization. | (defn- combine-dimensions
[dimension-name->field card-dimensions]
(reduce (fn [acc [d v]]
(cond-> acc
(acc d)
(update d into v)))
dimension-name->field
(map first card-dimensions))) |
(def ^:private ^{:arglists '([field])} id-or-name
(some-fn :id :name)) | |
(defn- singular-cell-dimensions
[{:keys [cell-query]}]
(letfn [(collect-dimensions [[op & args]]
(case (some-> op qp.util/normalize-token)
:and (mapcat collect-dimensions args)
:= (magic.util/collect-field-references args)
nil))]
(->> cell-query
collect-dimensions
(map magic.util/field-reference->id)
set))) | |
(defn- valid-breakout-dimension?
[{:keys [base_type db fingerprint aggregation]}]
(or (nil? aggregation)
(not (isa? base_type :type/Number))
(and (driver/database-supports? (:engine db) :binning db)
(-> fingerprint :type :type/Number :min)))) | |
(defn- valid-bindings? [{:keys [root]} satisfied-dimensions bindings]
(let [cell-dimension? (singular-cell-dimensions root)]
(->> satisfied-dimensions
(map first)
(map (fn [[identifier opts]]
(merge (bindings identifier) opts)))
(every? (every-pred valid-breakout-dimension?
(complement (comp cell-dimension? id-or-name))))))) | |
(mu/defn grounded-metrics->dashcards :- [:sequential ads/combined-metric]
"Generate dashcards from ground dimensions, using the base context, ground dimensions,
card templates, and grounded metrics as input."
[base-context
card-templates
ground-dimensions :- ads/dim-name->matching-fields
ground-filters
grounded-metrics :- [:sequential ads/grounded-metric]]
(let [metric-name->metric (zipmap
(map :metric-name grounded-metrics)
(map-indexed
(fn [idx grounded-metric] (assoc grounded-metric :position idx))
grounded-metrics))
simple-grounded-filters (update-vals
(group-by :filter-name ground-filters)
(fn [vs] (apply max-key :score vs)))]
(for [{card-name :card-name
card-metrics :metrics
card-score :card-score
card-dimensions :dimensions
card-filters :filters :as card-template} card-templates
:let [dim-names (map ffirst card-dimensions)]
:when (and (every? ground-dimensions dim-names)
(every? simple-grounded-filters card-filters))
:let [dim-score (map (comp :score ground-dimensions) dim-names)]
dimension-name->field (->> (map (comp :matches ground-dimensions) dim-names)
(apply math.combo/cartesian-product)
(map (partial zipmap dim-names)))
:let [merged-dims (combine-dimensions dimension-name->field card-dimensions)]
:when (and (valid-bindings? base-context card-dimensions dimension-name->field)
(every? metric-name->metric card-metrics))
:let [[grounded-metric :as all-satisfied-metrics] (map metric-name->metric card-metrics)
final-aggregate (into []
(comp (map (comp :aggregation :metric-definition))
cat)
all-satisfied-metrics)
bound-metric-dimension-name->field (apply merge (map :dimension-name->field all-satisfied-metrics))
card (-> card-template
(visualization/expand-visualization
(vals dimension-name->field)
nil)
(instantiate-metadata base-context
{}
(into dimension-name->field bound-metric-dimension-name->field)))
score-components (list* (:card-score card)
(:metric-score grounded-metric)
dim-score)]]
(merge
card
(-> grounded-metric
(assoc
:id (gensym)
:affinity-name card-name
:card-score card-score
:total-score (long (/ (apply + score-components) (count score-components)))
:score-components score-components)
(assoc-in [:metric-definition :aggregation] final-aggregate)
(update :metric-definition add-breakouts-and-filter
(vals merged-dims)
(mapv (comp :filter simple-grounded-filters) card-filters))
(add-dataset-query base-context)))))) | |
Convert a seq of items to a string. If more than two items are present, they are separated by commas, including the oxford comma on the final pairing. | (defn items->str
[[f s :as items]]
(condp = (count items)
0 ""
1 (str f)
2 (format "%s and %s" f s)
(format "%s, and %s" (str/join ", " (butlast items)) (last items)))) |
Name of the dimension. Trying for | (def dim-name (some-fn :display_name :name)) |
(ns metabase.automagic-dashboards.comparison
(:require
[medley.core :as m]
[metabase.api.common :as api]
[metabase.automagic-dashboards.core
:refer [->related-entity
->root
automagic-analysis
capitalize-first]]
[metabase.automagic-dashboards.filters :as filters]
[metabase.automagic-dashboards.names :as names]
[metabase.automagic-dashboards.populate :as populate]
[metabase.automagic-dashboards.util :as magic.util]
[metabase.mbql.normalize :as mbql.normalize]
[metabase.models.interface :as mi]
[metabase.models.table :refer [Table]]
[metabase.query-processor.util :as qp.util]
[metabase.related :as related]
[metabase.util :as u]
[metabase.util.i18n :refer [tru]])) | |
(def ^:private ^{:arglists '([root])} comparison-name
(comp capitalize-first (some-fn :comparison-name :full-name))) | |
(defn- dashboard->cards
[dashboard]
(->> dashboard
:dashcards
(map (fn [{:keys [size_y card col row series] :as dashcard}]
(assoc card
:text (-> dashcard :visualization_settings :text)
:series series
:height size_y
:position (+ (* row populate/grid-width) col))))
(sort-by :position))) | |
(defn- clone-card
[card]
(-> card
(select-keys [:dataset_query :description :display :name :result_metadata
:visualization_settings])
(assoc :creator_id api/*current-user-id*
:collection_id nil
:id (gensym)))) | |
(def ^:private ^{:arglists '([card])} display-type
(comp qp.util/normalize-token :display)) | |
Add | (defn- add-filter-clauses
[{{existing-filter-clause :filter} :query, :as query}, new-filter-clauses]
(let [clauses (filter identity (cons existing-filter-clause new-filter-clauses))
new-filter-clause (when (seq clauses)
(mbql.normalize/normalize-fragment [:query :filter] (cons :and clauses)))]
(cond-> query
(seq new-filter-clause) (assoc-in [:query :filter] new-filter-clause)))) |
Inject filter clause into card. | (defn- inject-filter
[{:keys [query-filter cell-query] :as root} card]
(-> card
(update :dataset_query #(add-filter-clauses % [query-filter cell-query]))
(update :series (partial map (partial inject-filter root))))) |
(defn- multiseries?
[card]
(or (-> card :series not-empty)
(-> card (get-in [:dataset_query :query :aggregation]) count (> 1))
(-> card (get-in [:dataset_query :query :breakout]) count (> 1)))) | |
(defn- overlay-comparison?
[card]
(and (-> card display-type (#{:bar :line}))
(not (multiseries? card)))) | |
(defn- comparison-row
[dashboard row left right card]
(if (:display card)
(let [height (:height card)
card-left (->> card (inject-filter left) clone-card)
card-right (->> card (inject-filter right) clone-card)
[color-left color-right] (->> [left right]
(map #(get-in % [:dataset_query :query :filter]))
populate/map-to-colors)]
(if (overlay-comparison? card)
(let [card (-> card-left
(assoc-in [:visualization_settings :graph.colors] [color-left color-right])
(update :name #(format "%s (%s)" % (comparison-name left))))
series (-> card-right
(update :name #(format "%s (%s)" % (comparison-name right)))
vector)]
(update dashboard :dashcards conj (merge (populate/card-defaults)
{:col 0
:row row
:size_x populate/grid-width
:size_y height
:card card
:card_id (:id card)
:series series
:visualization_settings {:graph.y_axis.auto_split false
:graph.series_labels [(:name card) (:name (first series))]}})))
(let [width (/ populate/grid-width 2)
series-left (map clone-card (:series card-left))
series-right (map clone-card (:series card-right))
card-left (cond-> card-left
(not (multiseries? card-left))
(assoc-in [:visualization_settings :graph.colors] [color-left]))
card-right (cond-> card-right
(not (multiseries? card-right))
(assoc-in [:visualization_settings :graph.colors] [color-right]))]
(-> dashboard
(update :dashcards conj (merge (populate/card-defaults)
{:col 0
:row row
:size_x width
:size_y height
:card card-left
:card_id (:id card-left)
:series series-left
:visualization_settings {}}))
(update :dashcards conj (merge (populate/card-defaults)
{:col width
:row row
:size_x width
:size_y height
:card card-right
:card_id (:id card-right)
:series series-right
:visualization_settings {}}))))))
(populate/add-text-card dashboard {:text (:text card)
:width (/ populate/grid-width 2)
:height (:height card)
:visualization-settings {:dashcard.background false
:text.align_vertical :bottom}}
[row 0]))) | |
(def ^:private ^Long ^:const title-height 2) | |
(defn- add-col-title
[dashboard title description col]
(let [height (cond-> title-height
description inc)]
[(populate/add-text-card dashboard
{:text (if description
(format "# %s\n\n%s" title description)
(format "# %s" title))
:width (/ populate/grid-width 2)
:height height
:visualization-settings {:dashcard.background false
:text.align_vertical :top}}
[0 col])
height])) | |
(defn- add-title-row
[dashboard left right]
(let [[dashboard height-left] (add-col-title dashboard
(comparison-name left)
(-> left :entity :description) 0)
[dashboard height-right] (add-col-title dashboard
(comparison-name right)
(-> right :entity :description)
(/ populate/grid-width 2))]
[dashboard (max height-left height-right)])) | |
(defn- series-labels
[card]
(get-in card [:visualization_settings :graph.series_labels]
(map (comp capitalize-first names/metric-name)
(get-in card [:dataset_query :query :aggregation])))) | |
(defn- unroll-multiseries
[card]
(if (and (multiseries? card)
(-> card :display (= :line)))
(for [[aggregation label] (map vector
(get-in card [:dataset_query :query :aggregation])
(series-labels card))]
(-> card
(assoc-in [:dataset_query :query :aggregation] [aggregation])
(assoc :name label)
(m/dissoc-in [:visualization_settings :graph.series_labels])))
[card])) | |
(defn- segment-constituents
[segment]
(->> (filters/inject-refinement (:query-filter segment) (:cell-query segment))
magic.util/collect-field-references
(map magic.util/field-reference->id)
distinct
(map (partial magic.util/->field segment)))) | |
(defn- update-related
[related left right]
(-> related
(update :related (comp distinct conj) (-> right :entity ->related-entity))
(assoc :compare (concat
(for [segment (->> left :entity related/related :segments (map ->root))
:when (not= segment right)]
{:url (str (:url left) "/compare/segment/"
(-> segment :entity u/the-id))
:title (tru "Compare with {0}" (:comparison-name segment))
:description })
(when (and ((some-fn :query-filter :cell-query) left)
(not= (:source left) (:entity right)))
[{:url (if (->> left :source (mi/instance-of? Table))
(str (:url left) "/compare/table/"
(-> left :source u/the-id))
(str (:url left) "/compare/adhoc/"
(magic.util/encode-base64-json
{:database (:database left)
:type :query
:query {:source-table (->> left
:source
u/the-id
(str "card__"))}})))
:title (tru "Compare with entire dataset")
:description }])))
(as-> related
(if (-> related :compare empty?)
(dissoc related :compare)
related)))) | |
(defn- part-vs-whole-comparison?
[left right]
(and ((some-fn :cell-query :query-filter) left)
(not ((some-fn :cell-query :query-filter) right)))) | |
Create a comparison dashboard based on dashboard | (defn comparison-dashboard
[dashboard left right opts]
(let [left (-> left
->root
(merge (:left opts)))
right (-> right
->root
(merge (:right opts)))
left (cond-> left
(-> opts :left :cell-query)
(assoc :comparison-name (->> opts
:left
:cell-query
(names/cell-title left))))
right (cond-> right
(part-vs-whole-comparison? left right)
(assoc :comparison-name (condp mi/instance-of? (:entity right)
Table
(tru "All {0}" (:short-name right))
(tru "{0}, all {1}"
(comparison-name right)
(names/source-name right)))))
segment-dashboards (->> (concat (segment-constituents left)
(segment-constituents right))
distinct
(map #(automagic-analysis % {:source (:source left)
:rules-prefix ["comparison"]})))]
(assert (or (= (:source left) (:source right))
(= (-> left :source :table_id) (-> right :source u/the-id))))
(->> (concat segment-dashboards [dashboard])
(reduce (fn [dashboard-1 dashboard-2]
(if dashboard-1
(populate/merge-dashboards dashboard-1 dashboard-2 {:skip-titles? true})
dashboard-2))
nil)
dashboard->cards
(m/distinct-by (some-fn :dataset_query hash))
(transduce (mapcat unroll-multiseries)
(fn
([]
(let [title (tru "Comparison of {0} and {1}"
(comparison-name left)
(comparison-name right))]
(-> {:name title
:transient_name title
:transient_filters nil
:param_fields nil
:description (tru "Automatically generated comparison dashboard comparing {0} and {1}"
(comparison-name left)
(comparison-name right))
:creator_id api/*current-user-id*
:parameters []
:related (update-related (:related dashboard) left right)}
(add-title-row left right))))
([[dashboard _row]] dashboard)
([[dashboard row] card]
[(comparison-row dashboard row left right card)
(+ row (:height card))])))))) |
Automatically generate questions and dashboards based on predefined heuristics. There are two key inputs to this algorithm: - An entity to generate the dashboard for. The primary data needed from this entity is: - The entity type itself - The field information, especially the metadata about these fields - A set of potential dashboard templates from which a dashboard can be realized based on the entity and field data The first step in the base Once potential templates are selected, the following process is attempted for each template in order of most specialized template to least: - Determine which entity fields map to dimensions and metrics described in the template. - Match these selected dimensions and metrics to required dimensions and metrics for cards specified in the template. - If any cards match, we successfully return a dashboard generated with the created cards. The following example is provided to better illustrate the template process and how dimensions and metrics work. This is a notional dashboard template:
Income | __/ Income | # # # X | * |/ | # # # # | * * * +---------- +----------- +----------------- Time Category Y Key things to note: - Each dimension in a card is specified by name. - There are 5 dimensions across all cards: - Income - Time - Category - X - Y - There are 3 metrics: - Count (N Items) - Avg Income - Total Income - Each metric is a computed value based on 0 or more dimensions, also specified by name. - Count is dimensionless - Avg and Total require the Income dimensions - Not shown, but a card such as "Sales by Location" could require 3 dimensions: - Total of the Sales dimension - Longitude and Latitude dimensions - A metric can also have multiple dimensions with its calculated value, such as the quotient of 2 dimensions. - Not described here are filters, which have the same nominal syntax for referencing dimensions as cards and metrics. Dimensions are the key Lego™ brick for all of the above and are specified as a named element with specialization based on entity and field semantic types as well as a score. For example, Income could have the following potential matches to underlying fields:
- A field from a Sales table with semantic type When matched with actual fields from an x-rayed entity, the highest matching field is selected to be "bound" to the Income dimensions. Suppose you have an entity of type SalesTable and fields of INCOME (semantic type Income), TAX (type Float), and TOTAL (Float). In this case, the INCOME field would match best (score 100) and be bound to the Income dimension. The other specified dimensions will have similar matching rules. Note that X & Y are, like all other dimensions,
named dimensions. In our above example the Income dimension matched to the INCOME field of type The above example, starting from the dashboard template, works backwards from the actual x-ray generation algorithm but should provide clarity as to the terminology and how everything fits together. In practice, we gather the entity data (including fields), the dashboard templates, attempt to bind dimensions to fields specified in the template, then build metrics, filters, and finally cards based on the bound dimensions. | (ns metabase.automagic-dashboards.core (:require [clojure.set :as set] [clojure.string :as str] [clojure.walk :as walk] [kixi.stats.core :as stats] [kixi.stats.math :as math] [medley.core :as m] [metabase.automagic-dashboards.combination :as combination] [metabase.automagic-dashboards.dashboard-templates :as dashboard-templates] [metabase.automagic-dashboards.filters :as filters] [metabase.automagic-dashboards.interesting :as interesting] [metabase.automagic-dashboards.names :as names] [metabase.automagic-dashboards.populate :as populate] [metabase.automagic-dashboards.util :as magic.util] [metabase.db.query :as mdb.query] [metabase.mbql.normalize :as mbql.normalize] [metabase.models.card :refer [Card]] [metabase.models.database :refer [Database]] [metabase.models.field :as field :refer [Field]] [metabase.models.interface :as mi] [metabase.models.metric :refer [Metric]] [metabase.models.query :refer [Query]] [metabase.models.segment :refer [Segment]] [metabase.models.table :refer [Table]] [metabase.query-processor.util :as qp.util] [metabase.related :as related] [metabase.sync.analyze.classify :as classify] [metabase.util :as u] [metabase.util.i18n :as i18n :refer [tru trun]] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [schema.core :as s] [toucan2.core :as t2])) |
(def ^:private public-endpoint "/auto/dashboard/") | |
(def ^:private ^{:arglists '([field])} id-or-name
(some-fn :id :name)) | |
Get user-defined metrics linked to a given entity. | (defmulti
^{:doc
:arglists '([entity])}
linked-metrics mi/model) |
(defmethod linked-metrics :model/Metric [{metric-name :name :keys [definition]}]
[{:metric-name metric-name
:metric-title metric-name
:metric-definition definition
:metric-score 100}]) | |
(defmethod linked-metrics :model/Table [{table-id :id}]
(mapcat
linked-metrics
(t2/select :model/Metric :table_id table-id))) | |
(defmethod linked-metrics :default [_] []) | |
root is a datatype that is an entity augmented with metadata for the purposes of creating an automatic dashboard with respect to that entity. It is called a root because the automated dashboard uses productions to recursively create a tree of dashboard cards to fill the dashboards. This multimethod is for turning a given entity into a root. | (defmulti ->root
{:arglists '([entity])}
mi/model) |
(defmethod ->root Table
[table]
{:entity table
:full-name (:display_name table)
:short-name (:display_name table)
:source table
:database (:db_id table)
:url (format "%stable/%s" public-endpoint (u/the-id table))
:dashboard-templates-prefix ["table"]
:linked-metrics (linked-metrics table)}) | |
(defmethod ->root Segment
[segment]
(let [table (->> segment :table_id (t2/select-one Table :id))]
{:entity segment
:full-name (tru "{0} in the {1} segment" (:display_name table) (:name segment))
:short-name (:display_name table)
:comparison-name (tru "{0} segment" (:name segment))
:source table
:database (:db_id table)
:query-filter [:segment (u/the-id segment)]
:url (format "%ssegment/%s" public-endpoint (u/the-id segment))
:dashboard-templates-prefix ["table"]})) | |
(defmethod ->root Metric
[metric]
(let [table (->> metric :table_id (t2/select-one Table :id))]
{:entity metric
:full-name (if (:id metric)
(trun "{0} metric" "{0} metrics" (:name metric))
(:name metric))
:short-name (:name metric)
:source table
:database (:db_id table)
;; We use :id here as it might not be a concrete field but rather one from a nested query which
;; does not have an ID.
:url (format "%smetric/%s" public-endpoint (:id metric))
:dashboard-templates-prefix ["metric"]})) | |
(defmethod ->root Field
[field]
(let [table (field/table field)]
{:entity field
:full-name (trun "{0} field" "{0} fields" (:display_name field))
:short-name (:display_name field)
:source table
:database (:db_id table)
;; We use :id here as it might not be a concrete metric but rather one from a nested query
;; which does not have an ID.
:url (format "%sfield/%s" public-endpoint (:id field))
:dashboard-templates-prefix ["field"]})) | |
Is this card or question derived from another model or question? | (def ^:private ^{:arglists '([card-or-question])} nested-query?
(comp some? qp.util/query->source-card-id :dataset_query)) |
Is this card or question native (SQL)? | (def ^:private ^{:arglists '([card-or-question])} native-query?
(comp some? #{:native} qp.util/normalize-token #(get-in % [:dataset_query :type]))) |
(defn- source-question
[card-or-question]
(when-let [source-card-id (qp.util/query->source-card-id (:dataset_query card-or-question))]
(t2/select-one Card :id source-card-id))) | |
(defn- table-like? [card-or-question] (nil? (get-in card-or-question [:dataset_query :query :aggregation]))) | |
Get the Table ID from | (defn- table-id
;; TODO - probably better if we just changed `adhoc-query` to use the same keys as Cards (e.g. `:table_id`) so we
;; didn't need this function, seems like something that would be too easy to forget
[card-or-question]
(or (:table_id card-or-question)
(:table-id card-or-question))) |
(defn- source
[card]
(cond
;; This is a model
(:dataset card) (assoc card :entity_type :entity/GenericTable)
;; This is a query based on a query. Eventually we will want to change this as it suffers from the same sourcing
;; problems as other cards -- The x-ray is not done on the card, but on its source.
(nested-query? card) (-> card
source-question
(assoc :entity_type :entity/GenericTable))
(native-query? card) (-> card (assoc :entity_type :entity/GenericTable))
:else (->> card table-id (t2/select-one Table :id)))) | |
(defmethod ->root Card
[card]
(let [{:keys [dataset] :as source} (source card)]
{:entity card
:source source
:database (:database_id card)
:query-filter (get-in card [:dataset_query :query :filter])
:full-name (tru "\"{0}\"" (:name card))
:short-name (names/source-name {:source source})
:url (format "%s%s/%s" public-endpoint (if dataset "model" "question") (u/the-id card))
:dashboard-templates-prefix [(if (table-like? card)
"table"
"question")]})) | |
(defmethod ->root Query
[query]
(let [source (source query)]
{:entity query
:source source
:database (:database-id query)
:query-filter (get-in query [:dataset_query :query :filter])
:full-name (cond
(native-query? query) (tru "Native query")
(table-like? query) (-> source ->root :full-name)
:else (names/question-description {:source source} query))
:short-name (names/source-name {:source source})
:url (format "%sadhoc/%s" public-endpoint
(magic.util/encode-base64-json (:dataset_query query)))
:dashboard-templates-prefix [(if (table-like? query)
"table"
"question")]})) | |
NOTE - This has been lifted to foo. Nuke it here as well. | (defn- fill-templates
[template-type {:keys [root tables]} bindings s]
(let [bindings (some-fn (merge {"this" (-> root
:entity
(assoc :full-name (:full-name root)))}
bindings)
(comp first #(magic.util/filter-tables % tables) dashboard-templates/->entity)
identity)]
(str/replace s #"\[\[(\w+)(?:\.([\w\-]+))?\]\]"
(fn [[_ identifier attribute]]
(let [entity (bindings identifier)
attribute (some-> attribute qp.util/normalize-token)]
(str (or (and (ifn? entity) (entity attribute))
(root attribute)
(interesting/->reference template-type entity)))))))) |
(defn- instantiate-visualization
[[k v] dimensions metrics]
(let [dimension->name (comp vector :name dimensions)
metric->name (comp vector first :metric metrics)]
[k (-> v
(m/update-existing :map.latitude_column dimension->name)
(m/update-existing :map.longitude_column dimension->name)
(m/update-existing :graph.metrics metric->name)
(m/update-existing :graph.dimensions dimension->name))])) | |
Capitalize only the first letter in a given string. | (defn capitalize-first
[s]
(let [s (str s)]
(str (u/upper-case-en (subs s 0 1)) (subs s 1)))) |
(defn- instantiate-metadata
[x context available-metrics bindings]
(-> (walk/postwalk
(fn [form]
(if (i18n/localized-string? form)
(let [s (str form)
new-s (fill-templates :string context bindings s)]
(if (not= new-s s)
(capitalize-first new-s)
s))
form))
x)
(m/update-existing :visualization #(instantiate-visualization % bindings available-metrics)))) | |
Return the set of ids referenced in a cell query | (defn- singular-cell-dimension-field-ids
[{:keys [cell-query]}]
(letfn [(collect-dimensions [[op & args]]
(case (some-> op qp.util/normalize-token)
:and (mapcat collect-dimensions args)
:= (magic.util/collect-field-references args)
nil))]
(->> cell-query
collect-dimensions
(map magic.util/field-reference->id)
set))) |
Return matching dashboard templates ordered by specificity. Most specific is defined as entity type specification the longest ancestor chain. | (defn- matching-dashboard-templates
[dashboard-templates {:keys [source entity]}]
;; Should this be here or lifted to the calling context. It's a magic step.
(let [table-type (or (:entity_type source) :entity/GenericTable)]
(->> dashboard-templates
(filter (fn [{:keys [applies_to]}]
(let [[entity-type field-type] applies_to]
(and (isa? table-type entity-type)
(or (nil? field-type)
(magic.util/field-isa? entity field-type))))))
(sort-by :specificity >)))) |
Return all tables accessible from a given table with the paths to get there. If there are multiple FKs pointing to the same table, multiple entries will be returned. | (defn- linked-tables
[table]
(for [{:keys [id target]} (field/with-targets
(t2/select Field
:table_id (u/the-id table)
:fk_target_field_id [:not= nil]
:active true))
:when (some-> target mi/can-read?)]
(-> target field/table (assoc :link id)))) |
(def ^:private ^{:arglists '([source])} source->db
(comp (partial t2/select-one Database :id) (some-fn :db_id :database_id))) | |
Source fields from tables that are applicable to the entity being x-rayed. | (defn- relevant-fields
[{:keys [source _entity] :as _root} tables]
(let [db (source->db source)]
(if (mi/instance-of? Table source)
(comp (->> (t2/select Field
:table_id [:in (map u/the-id tables)]
:visibility_type "normal"
:preview_display true
:active true)
field/with-targets
(map #(assoc % :db db))
(group-by :table_id))
u/the-id)
(let [source-fields (->> source
:result_metadata
(map (fn [field]
(as-> field field
(update field :base_type keyword)
(update field :semantic_type keyword)
(mi/instance Field field)
(classify/run-classifiers field {})
(assoc field :db db)))))]
(constantly source-fields))))) |
Create the underlying context to which we will add metrics, dimensions, and filters. This is applicable to all dashboard templates. | (s/defn ^:private make-base-context
[{:keys [source] :as root}]
{:pre [source]}
(let [tables (concat [source] (when (mi/instance-of? Table source)
(linked-tables source)))
table->fields (relevant-fields root tables)]
{:source (assoc source :fields (table->fields source))
:root root
:tables (map #(assoc % :fields (table->fields %)) tables)
:query-filter (filters/inject-refinement (:query-filter root)
(:cell-query root))})) |
(defn- make-dashboard
([root dashboard-template]
(make-dashboard root dashboard-template {:tables [(:source root)] :root root} nil))
([root dashboard-template context {:keys [available-metrics]}]
(-> dashboard-template
(select-keys [:title :description :transient_title :groups])
(cond->
(:comparison? root)
(update :groups (partial m/map-vals (fn [{:keys [title comparison_title] :as group}]
(assoc group :title (or comparison_title title))))))
(instantiate-metadata context available-metrics {})))) | |
Generate a map of satisfiable affinity sets (sets of dimensions that belong together) to visualization types that would be appropriate for each affinity set. | (defn affinities->viz-types
[normalized-card-templates ground-dimensions]
(reduce (partial merge-with set/union)
{}
(for [{:keys [dimensions visualization]} normalized-card-templates
:let [dim-set (into #{} (map ffirst) dimensions)]
:when (every? ground-dimensions dim-set)]
{dim-set #{visualization}}))) |
Create a dashboard group for each user-defined metric. | (defn user-defined-groups
[linked-metrics]
(zipmap (map :metric-name linked-metrics)
(map (fn [{:keys [metric-name]}]
{:title (format "Your %s Metric" metric-name)
:score 0}) linked-metrics))) |
Produce card templates for user-defined metrics. The basic algorithm is to generate the cross product of all user defined metrics to all provided dimension affinities to all potential visualization options for these affinities. | (defn user-defined-metrics->card-templates
[affinities->viz-types user-defined-metrics]
(let [found-summary? (volatile! false)
summary-viz-types #{["scalar" {}] ["smartscalar" {}]}]
(for [[dimension-affinities viz-types] affinities->viz-types
viz viz-types
{:keys [metric-name] :as _user-defined-metric} user-defined-metrics
:let [metric-title (if (seq dimension-affinities)
(format "%s by %s" metric-name
(combination/items->str
(map (fn [s] (format "[[%s]]" s)) (vec dimension-affinities))))
metric-name)
group-name (if (and (not @found-summary?)
(summary-viz-types viz))
(do (vreset! found-summary? true)
"Overview")
metric-name)]]
{:card-score 100
:metrics [metric-name]
:dimensions (mapv (fn [dim] {dim {}}) dimension-affinities)
:visualization viz
:width 6
:title (i18n/->UserLocalizedString metric-title nil {})
:height 4
:group group-name
:card-name (format "Card[%s][%s]" metric-title (first viz))}))) |
Produce the "base" dashboard from the base context for an item and a dashboard template. This includes dashcards and global filters, but does not include related items and is not yet populated. Repeated calls of this might be generated (e.g. the main dashboard and related) then combined once using create dashboard. | (defn generate-base-dashboard
[{{user-defined-metrics :linked-metrics :as root} :root :as base-context}
{template-cards :cards
:keys [dashboard_filters]
:as dashboard-template}
{grounded-dimensions :dimensions
grounded-metrics :metrics
grounded-filters :filters}]
(let [card-templates (interesting/normalize-seq-of-maps :card template-cards)
user-defined-card-templates (user-defined-metrics->card-templates
(affinities->viz-types card-templates grounded-dimensions)
user-defined-metrics)
all-cards (into card-templates user-defined-card-templates)
dashcards (combination/grounded-metrics->dashcards
base-context
all-cards
grounded-dimensions
grounded-filters
grounded-metrics)
template-with-user-groups (update dashboard-template
:groups into (user-defined-groups user-defined-metrics))
empty-dashboard (make-dashboard root template-with-user-groups)]
(assoc empty-dashboard
;; Adds the filters that show at the top of the dashboard
;; Why do we need (or do we) the last remove form?
:filters (->> dashboard_filters
(mapcat (comp :matches grounded-dimensions))
(remove (comp (singular-cell-dimension-field-ids root) id-or-name)))
:cards dashcards))) |
(def ^:private ^:const ^Long max-related 8) (def ^:private ^:const ^Long max-cards 15) | |
Turn | (defn ->related-entity
[entity]
(let [{:keys [dashboard-templates-prefix] :as root} (->root entity)
candidate-templates (dashboard-templates/get-dashboard-templates dashboard-templates-prefix)
dashboard-template (->> root
(matching-dashboard-templates candidate-templates)
first)
dashboard (make-dashboard root dashboard-template)]
{:url (:url root)
:title (:full-name root)
:description (:description dashboard)})) |
(defn- related-entities
[root]
(-> root
:entity
related/related
(update :fields (partial remove magic.util/key-col?))
(->> (m/map-vals (comp (partial map ->related-entity) u/one-or-many))))) | |
(s/defn ^:private indepth
[{:keys [dashboard-templates-prefix url] :as root}
{:keys [dashboard-template-name]} :- (s/maybe dashboard-templates/DashboardTemplate)]
(let [base-context (make-base-context root)]
(->> (dashboard-templates/get-dashboard-templates (concat dashboard-templates-prefix [dashboard-template-name]))
(keep (fn [{indepth-template-name :dashboard-template-name
template-dimensions :dimensions
template-metrics :metrics
template-filters :filters
:as indepth}]
(let [grounded-values (interesting/identify
base-context
{:dimension-specs template-dimensions
:metric-specs template-metrics
:filter-specs template-filters})
{:keys [description cards] :as dashboard} (generate-base-dashboard
base-context
indepth
grounded-values)]
(when (and description (seq cards))
{:title ((some-fn :short-title :title) dashboard)
:description description
:url (format "%s/rule/%s/%s" url dashboard-template-name indepth-template-name)}))))
(hash-map :indepth)))) | |
(defn- drilldown-fields
[root available-dimensions]
(when (and (->> root :source (mi/instance-of? Table))
(-> root :entity magic.util/ga-table? not))
(->> available-dimensions
vals
(mapcat :matches)
(filter mi/can-read?)
filters/interesting-fields
(map ->related-entity)
(hash-map :drilldown-fields)))) | |
(defn- comparisons
[root]
{:compare (concat
(for [segment (->> root :entity related/related :segments (map ->root))]
{:url (str (:url root) "/compare/segment/" (-> segment :entity u/the-id))
:title (tru "Compare with {0}" (:comparison-name segment))
:description })
(when ((some-fn :query-filter :cell-query) root)
[{:url (if (->> root :source (mi/instance-of? Table))
(str (:url root) "/compare/table/" (-> root :source u/the-id))
(str (:url root) "/compare/adhoc/"
(magic.util/encode-base64-json
{:database (:database root)
:type :query
:query {:source-table (->> root
:source
u/the-id
(str "card__"))}})))
:title (tru "Compare with entire dataset")
:description }]))}) | |
We fill available slots round-robin style. Each selector is a list of fns that are tried against
| (defn- fill-related
[available-slots selectors related]
(let [pop-first (fn [m ks]
(loop [[k & ks] ks]
(let [item (-> k m first)]
(cond
item [item (update m k rest)]
(empty? ks) [nil m]
:else (recur ks)))))
count-leafs (comp count (partial mapcat val))
[selected related] (reduce-kv
(fn [[selected related] k v]
(loop [[selector & remaining-selectors] v
related related
selected selected]
(let [[next related] (pop-first related (mapcat shuffle selector))
num-selected (count-leafs selected)]
(cond
(= num-selected available-slots)
(reduced [selected related])
next
(recur remaining-selectors related (update selected k conj next))
(empty? remaining-selectors)
[selected related]
:else
(recur remaining-selectors related selected)))))
[{} related]
selectors)
num-selected (count-leafs selected)]
(if (pos? num-selected)
(merge-with concat
selected
(fill-related (- available-slots num-selected) selectors related))
{}))) |
(def ^:private related-selectors
{Table (let [down [[:indepth] [:segments :metrics] [:drilldown-fields]]
sideways [[:linking-to :linked-from] [:tables]]
compare [[:compare]]]
{:zoom-in [down down down down]
:related [sideways sideways]
:compare [compare compare]})
Segment (let [down [[:indepth] [:segments :metrics] [:drilldown-fields]]
sideways [[:linking-to] [:tables]]
up [[:table]]
compare [[:compare]]]
{:zoom-in [down down down]
:zoom-out [up]
:related [sideways sideways]
:compare [compare compare]})
Metric (let [down [[:drilldown-fields]]
sideways [[:metrics :segments]]
up [[:table]]
compare [[:compare]]]
{:zoom-in [down down]
:zoom-out [up]
:related [sideways sideways sideways]
:compare [compare compare]})
Field (let [sideways [[:fields]]
up [[:table] [:metrics :segments]]
compare [[:compare]]]
{:zoom-out [up]
:related [sideways sideways]
:compare [compare]})
Card (let [down [[:drilldown-fields]]
sideways [[:metrics] [:similar-questions :dashboard-mates]]
up [[:table]]
compare [[:compare]]]
{:zoom-in [down down]
:zoom-out [up]
:related [sideways sideways sideways]
:compare [compare compare]})
Query (let [down [[:drilldown-fields]]
sideways [[:metrics] [:similar-questions]]
up [[:table]]
compare [[:compare]]]
{:zoom-in [down down]
:zoom-out [up]
:related [sideways sideways sideways]
:compare [compare compare]})}) | |
Build a balanced list of related X-rays. General composition of the list is determined for each
root type individually via | (s/defn ^:private related
[root
available-dimensions
dashboard-template :- (s/maybe dashboard-templates/DashboardTemplate)]
(->> (merge (indepth root dashboard-template)
(drilldown-fields root available-dimensions)
(related-entities root)
(comparisons root))
(fill-related max-related (get related-selectors (-> root :entity mi/model))))) |
Return a map of fields referenced in filter clause. | (defn- filter-referenced-fields
[root filter-clause]
(->> filter-clause
magic.util/collect-field-references
(map (fn [[_ id-or-name _options]]
[id-or-name (magic.util/->field root id-or-name)]))
(remove (comp nil? second))
(into {}))) |
Produce a fully-populated dashboard from the base context for an item and a dashboard template. | (defn generate-dashboard
[{{:keys [show url query-filter] :as root} :root :as base-context}
{:as dashboard-template}
{grounded-dimensions :dimensions :as grounded-values}]
(let [show (or show max-cards)
dashboard (generate-base-dashboard base-context dashboard-template grounded-values)]
(-> dashboard
(populate/create-dashboard show)
(assoc
:related (related
root grounded-dimensions
dashboard-template)
:more (when (and (not= show :all)
(-> dashboard :cards count (> show)))
(format "%s#show=all" url))
:transient_filters query-filter
:param_fields (filter-referenced-fields root query-filter)
:auto_apply_filters true)))) |
Create dashboards for table | (defn- automagic-dashboard
[{:keys [dashboard-template dashboard-templates-prefix] :as root}]
(let [base-context (make-base-context root)
{template-dimensions :dimensions
template-metrics :metrics
template-filters :filters
:as template} (if dashboard-template
(dashboard-templates/get-dashboard-template dashboard-template)
(first (matching-dashboard-templates
(dashboard-templates/get-dashboard-templates dashboard-templates-prefix)
root)))
grounded-values (interesting/identify
base-context
{:dimension-specs template-dimensions
:metric-specs template-metrics
:filter-specs template-filters})]
(generate-dashboard base-context template grounded-values))) |
Create a transient dashboard analyzing given entity. | (defmulti automagic-analysis
{:arglists '([entity opts])}
(fn [entity _]
(mi/model entity))) |
(defmethod automagic-analysis Table [table opts] (automagic-dashboard (merge (->root table) opts))) | |
(defmethod automagic-analysis Segment [segment opts] (automagic-dashboard (merge (->root segment) opts))) | |
(defmethod automagic-analysis Metric [metric opts] (automagic-dashboard (merge (->root metric) opts))) | |
(mu/defn ^:private collect-metrics :- [:maybe [:sequential (ms/InstanceOf Metric)]]
[root question]
(map (fn [aggregation-clause]
(if (-> aggregation-clause
first
qp.util/normalize-token
(= :metric))
(->> aggregation-clause second (t2/select-one Metric :id))
(let [table-id (table-id question)]
(mi/instance Metric {:definition {:aggregation [aggregation-clause]
:source-table table-id}
:name (names/metric->description root aggregation-clause)
:table_id table-id}))))
(get-in question [:dataset_query :query :aggregation]))) | |
(mu/defn ^:private collect-breakout-fields :- [:maybe [:sequential (ms/InstanceOf Field)]]
[root question]
(for [breakout (get-in question [:dataset_query :query :breakout])
field-clause (take 1 (magic.util/collect-field-references breakout))
:let [field (magic.util/->field root field-clause)]
:when field]
field)) | |
(defn- decompose-question
[root question opts]
(letfn [(analyze [x]
(try
(automagic-analysis x (assoc opts
:source (:source root)
:query-filter (:query-filter root)
:database (:database root)))
(catch Throwable e
(throw (ex-info (tru "Error decomposing question: {0}" (ex-message e))
{:root root, :question question, :object x}
e)))))]
(into []
(comp cat (map analyze))
[(collect-metrics root question)
(collect-breakout-fields root question)]))) | |
Ensure that elements of an original dataset query are preserved in dashcard queries. | (defn- preserve-entity-element
[dashboard entity entity-element]
(if-let [element-value (get-in entity [:dataset_query :query entity-element])]
(letfn [(splice-element [dashcard]
(cond-> dashcard
(get-in dashcard [:card :dataset_query :query])
(update-in [:card :dataset_query :query entity-element]
(fnil into (empty element-value))
element-value)))]
(update dashboard :dashcards (partial map splice-element)))
dashboard)) |
(defn- query-based-analysis
[{:keys [entity] :as root} opts {:keys [cell-query cell-url]}]
(let [transient-dash (if (table-like? entity)
(let [root' (merge root
(when cell-query
{:url cell-url
:entity (:source root)
:dashboard-templates-prefix ["table"]})
opts)]
(automagic-dashboard root'))
(let [opts (assoc opts :show :all)
root' (merge root
(when cell-query
{:url cell-url})
opts)
base-dash (automagic-dashboard root')
dash (reduce populate/merge-dashboards
base-dash
(decompose-question root entity opts))]
(merge dash
(when cell-query
(let [title (tru "A closer look at {0}" (names/cell-title root cell-query))]
{:transient_name title
:name title})))))]
(-> transient-dash
(preserve-entity-element (:entity root) :joins)
(preserve-entity-element (:entity root) :expressions)))) | |
(defmethod automagic-analysis Card
[card {:keys [cell-query] :as opts}]
(let [root (->root card)
cell-url (format "%squestion/%s/cell/%s" public-endpoint
(u/the-id card)
(magic.util/encode-base64-json cell-query))]
(query-based-analysis root opts
(when cell-query
{:cell-query cell-query
:cell-url cell-url})))) | |
(defmethod automagic-analysis Query
[query {:keys [cell-query] :as opts}]
(let [root (->root query)
cell-query (when cell-query (mbql.normalize/normalize-fragment [:query :filter] cell-query))
opts (cond-> opts
cell-query (assoc :cell-query cell-query))
cell-url (format "%sadhoc/%s/cell/%s" public-endpoint
(magic.util/encode-base64-json (:dataset_query query))
(magic.util/encode-base64-json cell-query))]
(query-based-analysis root opts
(when cell-query
{:cell-query cell-query
:cell-url cell-url})))) | |
(defmethod automagic-analysis Field [field opts] (automagic-dashboard (merge (->root field) opts))) | |
Add a stats field to each provided table with the following data: - num-fields: The number of Fields in each table - list-like?: Is this field 'list like' - link-table?: Is every Field a foreign key to another table | (defn- enhance-table-stats
[tables]
(when (not-empty tables)
(let [field-count (->> (mdb.query/query {:select [:table_id [:%count.* "count"]]
:from [:metabase_field]
:where [:and [:in :table_id (map u/the-id tables)]
[:= :active true]]
:group-by [:table_id]})
(into {} (map (juxt :table_id :count))))
list-like? (->> (when-let [candidates (->> field-count
(filter (comp (partial >= 2) val))
(map key)
not-empty)]
(mdb.query/query {:select [:table_id]
:from [:metabase_field]
:where [:and [:in :table_id candidates]
[:= :active true]
[:or [:not= :semantic_type "type/PK"]
[:= :semantic_type nil]]]
:group-by [:table_id]
:having [:= :%count.* 1]}))
(into #{} (map :table_id)))
;; Table comprised entierly of join keys
link-table? (when (seq field-count)
(->> (mdb.query/query {:select [:table_id [:%count.* "count"]]
:from [:metabase_field]
:where [:and [:in :table_id (keys field-count)]
[:= :active true]
[:in :semantic_type ["type/PK" "type/FK"]]]
:group-by [:table_id]})
(filter (fn [{:keys [table_id count]}]
(= count (field-count table_id))))
(into #{} (map :table_id))))]
(for [table tables]
(let [table-id (u/the-id table)]
(assoc table :stats {:num-fields (field-count table-id 0)
:list-like? (boolean (contains? list-like? table-id))
:link-table? (boolean (contains? link-table? table-id))})))))) |
Maximal number of tables per schema shown in | (def ^:private ^:const ^Long max-candidate-tables 10) |
Return a list of tables in database with ID Tables are ranked based on how specific dashboard template has been used, and the number of fields. Schemes are ranked based on the number of distinct entity types and the interestingness of tables they contain (see above). | (defn candidate-tables
([database] (candidate-tables database nil))
([database schema]
(let [dashboard-templates (dashboard-templates/get-dashboard-templates ["table"])]
(->> (apply t2/select [Table :id :schema :display_name :entity_type :db_id]
(cond-> [:db_id (u/the-id database)
:visibility_type nil
:active true]
schema (concat [:schema schema])))
(filter mi/can-read?)
enhance-table-stats
(remove (comp (some-fn :link-table? (comp zero? :num-fields)) :stats))
(map (fn [table]
(let [root (->root table)
{:keys [dashboard-template-name]
:as dashboard-template} (->> root
(matching-dashboard-templates dashboard-templates)
first)
dashboard (make-dashboard root dashboard-template)]
{:url (format "%stable/%s" public-endpoint (u/the-id table))
:title (:short-name root)
:score (+ (math/sq (:specificity dashboard-template))
(math/log (-> table :stats :num-fields))
(if (-> table :stats :list-like?)
-10
0))
:description (:description dashboard)
:table table
:dashboard-template-name dashboard-template-name})))
(group-by (comp :schema :table))
(map (fn [[schema tables]]
(let [tables (->> tables
(sort-by :score >)
(take max-candidate-tables))]
{:id (format "%s/%s" (u/the-id database) schema)
:tables tables
:schema schema
:score (+ (math/sq (transduce (m/distinct-by :dashboard-template-name)
stats/count
tables))
(math/sqrt (transduce (map (comp math/sq :score))
stats/mean
tables)))})))
(sort-by :score >))))) |
Validation, transformation to canonical form, and loading of heuristics. | (ns metabase.automagic-dashboards.dashboard-templates
(:gen-class)
(:require
[clojure.set :as set]
[clojure.string :as str]
[metabase.automagic-dashboards.populate :as populate]
[metabase.query-processor.util :as qp.util]
[metabase.util :as u]
[metabase.util.files :as u.files]
[metabase.util.i18n :as i18n :refer [deferred-trs LocalizedString]]
#_{:clj-kondo/ignore [:deprecated-namespace]}
[metabase.util.schema :as su]
[metabase.util.yaml :as yaml]
[schema.coerce :as sc]
[schema.core :as s]
[schema.spec.core :as spec])
(:import
(java.nio.file Files Path))) |
(set! *warn-on-reflection* true) | |
Maximal (and default) value for heuristics scores. | (def ^Long ^:const max-score 100) |
(def ^:private Score (s/constrained s/Int #(<= 0 % max-score)
(deferred-trs "0 <= score <= {0}" max-score))) | |
(def ^:private MBQL [s/Any]) | |
(def ^:private Identifier s/Str) | |
(def ^:private Metric {Identifier {(s/required-key :metric) MBQL
(s/required-key :score) Score
(s/optional-key :name) LocalizedString}}) | |
(def ^:private Filter {Identifier {(s/required-key :filter) MBQL
(s/required-key :score) Score}}) | |
Does string | (defn ga-dimension? [t] (str/starts-with? t "ga:")) |
Turn | (defn ->type
[x]
(cond
(keyword? x) x
(ga-dimension? x) x
:else (keyword "type" x))) |
Turn | (defn ->entity
[x]
(cond
(keyword? x) x
(ga-dimension? x) x
:else (keyword "entity" x))) |
(defn- field-type? [t] (some (partial isa? t) [:type/* :Semantic/* :Relation/*])) | |
(defn- table-type? [t] (isa? t :entity/*)) | |
(def ^:private TableType (s/constrained s/Keyword table-type?))
(def ^:private FieldType (s/cond-pre (s/constrained s/Str ga-dimension?)
(s/constrained s/Keyword field-type?))) | |
(def ^:private AppliesTo (s/either [FieldType]
[TableType]
[(s/one TableType "table") FieldType])) | |
(def ^:private Dimension {Identifier {(s/required-key :field_type) AppliesTo
(s/required-key :score) Score
(s/optional-key :links_to) TableType
(s/optional-key :named) s/Str
(s/optional-key :max_cardinality) s/Int}}) | |
(def ^:private OrderByPair {Identifier (s/enum "descending" "ascending")}) | |
(def ^:private Visualization [(s/one s/Str "visualization") su/Map]) | |
(def ^:private Width (s/constrained s/Int #(<= 1 % populate/grid-width)
(deferred-trs "1 <= width <= {0}" populate/grid-width)))
(def ^:private Height (s/constrained s/Int pos?)) | |
(def ^:private CardDimension {Identifier {(s/optional-key :aggregation) s/Str}}) | |
(def ^:private Card
{Identifier {(s/required-key :title) LocalizedString
(s/required-key :card-score) Score
(s/optional-key :visualization) Visualization
(s/optional-key :text) LocalizedString
(s/optional-key :dimensions) [CardDimension]
(s/optional-key :filters) [s/Str]
(s/optional-key :metrics) [s/Str]
(s/optional-key :limit) su/IntGreaterThanZero
(s/optional-key :order_by) [OrderByPair]
(s/optional-key :description) LocalizedString
(s/optional-key :query) s/Str
(s/optional-key :width) Width
(s/optional-key :height) Height
(s/optional-key :group) s/Str
(s/optional-key :y_label) LocalizedString
(s/optional-key :x_label) LocalizedString
(s/optional-key :series_labels) [LocalizedString]}}) | |
(def ^:private Groups
{Identifier {(s/required-key :title) LocalizedString
(s/required-key :score) s/Int
(s/optional-key :comparison_title) LocalizedString
(s/optional-key :description) LocalizedString}}) | |
Return | (def ^{:arglists '([definition])} identifier
(comp key first)) |
(def ^:private ^{:arglists '([definitions])} identifiers
(partial into #{"this"} (map identifier))) | |
(defn- all-references [k cards] (mapcat (comp k val first) cards)) | |
(def ^:private DimensionForm
[(s/one (s/constrained (s/cond-pre s/Str s/Keyword) (comp #{:dimension} qp.util/normalize-token))
"dimension")
(s/one s/Str "identifier")
su/Map]) | |
Does form denote a dimension reference? | (def ^{:arglists '([form])} dimension-form?
(complement (s/checker DimensionForm))) |
Return all dimension references in form. | (defn collect-dimensions
[form]
(->> form
(tree-seq (some-fn map? sequential?) identity)
(mapcat (fn [subform]
(cond
(dimension-form? subform) [(second subform)]
(string? subform) (->> subform
(re-seq #"\[\[(\w+)\]\]")
(map second)))))
distinct)) |
(defn- valid-metrics-references?
[{:keys [metrics cards]}]
(every? (identifiers metrics) (all-references :metrics cards))) | |
(defn- valid-filters-references?
[{:keys [filters cards]}]
(every? (identifiers filters) (all-references :filters cards))) | |
(defn- valid-group-references?
[{:keys [cards groups]}]
(every? groups (keep (comp :group val first) cards))) | |
(defn- valid-order-by-references?
[{:keys [dimensions metrics cards]}]
(every? (comp (into (identifiers dimensions)
(identifiers metrics))
identifier)
(all-references :order_by cards))) | |
(defn- valid-dimension-references?
[{:keys [dimensions] :as dashboard-template}]
(every? (some-fn (identifiers dimensions) (comp table-type? ->entity))
(collect-dimensions dashboard-template))) | |
(defn- valid-dashboard-filters-references?
[{:keys [dimensions dashboard_filters]}]
(every? (identifiers dimensions) dashboard_filters)) | |
(defn- valid-breakout-dimension-references?
[{:keys [cards dimensions]}]
(->> cards
(all-references :dimensions)
(map identifier)
(every? (identifiers dimensions)))) | |
(defn- constrained-all
[schema & constraints]
(reduce (partial apply s/constrained)
schema
(partition 2 constraints))) | |
Specification defining an automagic dashboard. | (def DashboardTemplate
(constrained-all
{(s/required-key :title) LocalizedString
(s/required-key :dashboard-template-name) s/Str
(s/required-key :specificity) s/Int
(s/optional-key :cards) [Card]
(s/optional-key :dimensions) [Dimension]
(s/optional-key :applies_to) AppliesTo
(s/optional-key :transient_title) LocalizedString
(s/optional-key :description) LocalizedString
(s/optional-key :metrics) [Metric]
(s/optional-key :filters) [Filter]
(s/optional-key :groups) Groups
(s/optional-key :indepth) [s/Any]
(s/optional-key :dashboard_filters) [s/Str]}
valid-metrics-references? (deferred-trs "Valid metrics references")
valid-filters-references? (deferred-trs "Valid filters references")
valid-group-references? (deferred-trs "Valid group references")
valid-order-by-references? (deferred-trs "Valid order_by references")
valid-dashboard-filters-references? (deferred-trs "Valid dashboard filters references")
valid-dimension-references? (deferred-trs "Valid dimension references")
valid-breakout-dimension-references? (deferred-trs "Valid card dimension references"))) |
(defn- with-defaults
[defaults]
(fn [x]
(let [[identifier definition] (first x)]
{identifier (merge defaults definition)}))) | |
Expand definition of the form {identifier value} with regards to key | (defn- shorthand-definition
[k]
(fn [x]
(let [[identifier definition] (first x)]
(if (map? definition)
x
{identifier {k definition}})))) |
(def ^:private dashboard-template-validator
(sc/coercer!
DashboardTemplate
{[s/Str] u/one-or-many
[OrderByPair] u/one-or-many
OrderByPair (fn [x]
(if (string? x)
{x "ascending"}
x))
Visualization (fn [x]
(if (string? x)
[x {}]
(first x)))
Metric (comp (with-defaults {:score max-score})
(shorthand-definition :metric))
Dimension (comp (with-defaults {:score max-score})
(shorthand-definition :field_type))
Filter (comp (with-defaults {:score max-score})
(shorthand-definition :filter))
Card (with-defaults {:card-score max-score
:width populate/default-card-width
:height populate/default-card-height})
[CardDimension] u/one-or-many
CardDimension (fn [x]
(if (string? x)
{x {}}
x))
TableType ->entity
FieldType ->type
Identifier (fn [x]
(if (keyword? x)
(name x)
x))
Groups (partial apply merge)
AppliesTo (fn [x]
(let [[table-type field-type] (str/split x #"\.")]
(if field-type
[(->entity table-type) (->type field-type)]
[(if (-> table-type ->entity table-type?)
(->entity table-type)
(->type table-type))])))
LocalizedString (fn [s]
(i18n/->UserLocalizedString s nil {}))})) | |
(def ^:private dashboard-templates-dir "automagic_dashboards/") | |
(def ^:private ^{:arglists '([f])} file->entity-type
(comp (partial re-find #".+(?=\.yaml$)") str (memfn ^Path getFileName))) | |
(defn- specificity [dashboard-template] (transduce (map (comp count ancestors)) + (:applies_to dashboard-template))) | |
(defn- make-dashboard-template
[entity-type {:keys [cards] :as r}]
(-> (cond-> r
(seq cards)
(update :cards (partial mapv (fn [m] (update-vals m #(set/rename-keys % {:score :card-score}))))))
(assoc :dashboard-template-name entity-type
:specificity 0)
(update :applies_to #(or % entity-type))
dashboard-template-validator
(as-> dashboard-template
(assoc dashboard-template
:specificity (specificity dashboard-template))))) | |
(defn- trim-trailing-slash
[s]
(if (str/ends-with? s "/")
(subs s 0 (-> s count dec))
s)) | |
(defn- load-dashboard-template-dir
([dir] (load-dashboard-template-dir dir [] {}))
([dir path dashboard-templates]
(with-open [ds (Files/newDirectoryStream dir)]
(reduce
(fn [acc ^Path f]
(let [entity-type (file->entity-type f)]
(cond
(Files/isDirectory f (into-array java.nio.file.LinkOption []))
(load-dashboard-template-dir f (->> f (.getFileName) str trim-trailing-slash (conj path)) acc)
entity-type
(assoc-in acc (concat path [entity-type ::leaf]) (yaml/load (partial make-dashboard-template entity-type) f))
:else
acc)))
dashboard-templates
ds)))) | |
(def ^:private dashboard-templates
(delay
(u.files/with-open-path-to-resource [path dashboard-templates-dir]
(into {} (load-dashboard-template-dir path))))) | |
Get all dashboard templates with prefix | (defn get-dashboard-templates
[prefix]
(->> prefix
(get-in @dashboard-templates)
(keep (comp ::leaf val)))) |
Get dashboard template at path | (defn get-dashboard-template [path] (get-in @dashboard-templates (concat path [::leaf]))) |
(defn- extract-localized-strings
[[path dashboard-template]]
(let [strings (atom [])]
((spec/run-checker
(fn [s params]
(let [walk (spec/checker (s/spec s) params)]
(fn [x]
(when (= LocalizedString s)
(swap! strings conj x))
(walk x))))
false
DashboardTemplate)
dashboard-template)
(map vector (distinct @strings) (repeat path)))) | |
(defn- make-pot
[strings]
(->> strings
(group-by first)
(mapcat (fn [[s ctxs]]
(concat (for [[_ ctx] ctxs]
(format "#: resources/%s%s.yaml" dashboard-templates-dir (str/join "/" ctx)))
[(format "msgid \"%s\"\nmsgstr \"\"\n" s)])))
(str/join "\n"))) | |
(defn- all-dashboard-templates
([]
(all-dashboard-templates [] @dashboard-templates))
([path dashboard-templates]
(when (map? dashboard-templates)
(mapcat (fn [[k v]]
(if (= k ::leaf)
[[path v]]
(all-dashboard-templates (conj path k) v)))
dashboard-templates)))) | |
Entry point for Clojure CLI task clojure -M:generate-automagic-dashboards-pot | (defn -main
[& _]
(->> (all-dashboard-templates)
(mapcat extract-localized-strings)
make-pot
(spit "locales/metabase-automatic-dashboards.pot"))
(System/exit 0)) |
(ns metabase.automagic-dashboards.filters (:require [metabase.automagic-dashboards.util :as magic.util] [metabase.mbql.normalize :as mbql.normalize] [metabase.mbql.util :as mbql.u] [metabase.models.field :as field :refer [Field]] [metabase.util :as u] [metabase.util.date-2 :as u.date] [toucan2.core :as t2])) | |
Does | (defn- temporal?
[{base-type :base_type, effective-type :effective_type, unit :unit}]
;; TODO -- not sure why we're excluding year here? Is it because we normally returned it as an integer in the past?
(and (not ((disj u.date/extract-units :year) unit))
(isa? (or effective-type base-type) :type/Temporal))) |
(defn- interestingness
[{base-type :base_type, effective-type :effective_type, semantic-type :semantic_type, :keys [fingerprint]}]
(cond-> 0
(some-> fingerprint :global :distinct-count (< 10)) inc
(some-> fingerprint :global :distinct-count (> 20)) dec
((descendants :type/Category) semantic-type) inc
(isa? (or effective-type base-type) :type/Temporal) inc
((descendants :type/Temporal) semantic-type) inc
(isa? semantic-type :type/CreationTimestamp) inc
(#{:type/State :type/Country} semantic-type) inc)) | |
(defn- interleave-all
[& colls]
(lazy-seq
(when (seq colls)
(concat (map first colls) (apply interleave-all (keep (comp seq rest) colls)))))) | |
(defn- sort-by-interestingness
[fields]
(->> fields
(map #(assoc % :interestingness (interestingness %)))
(sort-by interestingness >)
(partition-by :interestingness)
(mapcat (fn [fields]
(->> fields
(group-by (juxt :base_type :semantic_type))
vals
(apply interleave-all)))))) | |
Pick out interesting fields and sort them by interestingness. | (defn interesting-fields
[fields]
(->> fields
(filter (fn [{:keys [semantic_type] :as field}]
(or (temporal? field)
(isa? semantic_type :type/Category))))
sort-by-interestingness)) |
(defn- candidates-for-filtering
[fieldset cards]
(->> cards
(mapcat magic.util/collect-field-references)
(map magic.util/field-reference->id)
distinct
(map fieldset)
interesting-fields)) | |
(defn- build-fk-map
[fks field]
(if (:id field)
(->> fks
(filter (comp #{(:table_id field)} :table_id :target))
(group-by :table_id)
(keep (fn [[_ [fk & fks]]]
;; Bail out if there is more than one FK from the same table
(when (empty? fks)
[(:table_id fk) [:field (u/the-id field) {:source-field (u/the-id fk)}]])))
(into {(:table_id field) [:field (u/the-id field) nil]}))
(constantly [:field (:name field) {:base-type (:base_type field)}]))) | |
(defn- filter-for-card
[card field]
(some->> ((:fk-map field) (:table_id card))
(vector :dimension))) | |
(defn- add-filter
[dashcard filter-id field]
(let [mappings (->> (conj (:series dashcard) (:card dashcard))
(keep (fn [card]
(when-let [target (filter-for-card card field)]
{:parameter_id filter-id
:target target
:card_id (:id card)})))
not-empty)]
(cond
(nil? (:card dashcard)) dashcard
mappings (update dashcard :parameter_mappings concat mappings)))) | |
Return filter type for a given field. | (defn- filter-type
[{:keys [semantic_type] :as field}]
(cond
(temporal? field) "date/all-options"
(isa? semantic_type :type/State) "location/state"
(isa? semantic_type :type/Country) "location/country"
(isa? semantic_type :type/Category) "category")) |
(def ^:private ^{:arglists '([dimensions])} remove-unqualified
(partial remove (fn [{:keys [fingerprint]}]
(some-> fingerprint :global :distinct-count (< 2))))) | |
Add up to | (defn add-filters
([dashboard max-filters]
(->> dashboard
:orderd_cards
(candidates-for-filtering (->> dashboard
:context
:tables
(mapcat :fields)
(map (fn [field]
[((some-fn :id :name) field) field]))
(into {})))
(add-filters dashboard max-filters)))
([dashboard dimensions max-filters]
(let [fks (when-let [table-ids (not-empty (set (keep (comp :table_id :card)
(:dashcards dashboard))))]
(->> (t2/select Field :fk_target_field_id [:not= nil]
:table_id [:in table-ids])
field/with-targets))]
(->> dimensions
remove-unqualified
sort-by-interestingness
(take max-filters)
(reduce
(fn [dashboard candidate]
(let [filter-id (-> candidate ((juxt :id :name :unit)) hash str)
candidate (assoc candidate :fk-map (build-fk-map fks candidate))
dashcards (:dashcards dashboard)
dashcards-new (keep #(add-filter % filter-id candidate) dashcards)]
;; Only add filters that apply to all cards.
(if (= (count dashcards) (count dashcards-new))
(-> dashboard
(assoc :dashcards dashcards-new)
(update :parameters conj {:id filter-id
:type (filter-type candidate)
:name (:display_name candidate)
:slug (:name candidate)}))
dashboard)))
dashboard))))) |
Returns a sequence of filter subclauses making up (flatten-filter-clause [:and [:= [:field 1 nil] 2] [:and [:= [:field 3 nil] 4] [:= [:field 5 nil] 6]]]) ;; -> ([:= [:field 1 nil] 2] [:= [:field 3 nil] 4] [:= [:field 5 nil] 6]) | (defn- flatten-filter-clause
[[clause-name, :as filter-clause]]
(when (seq filter-clause)
(if (= clause-name :and)
(rest (mbql.u/simplify-compound-filter filter-clause))
[filter-clause]))) |
Inject a filter refinement into an MBQL filter clause, returning a new filter clause. There are two reasons why we want to do this: 1) to reduce visual noise when we display applied filters; and 2) some DBs don't do this optimization or even protest (eg. GA) if there are duplicate clauses. Assumes that any refinement sub-clauses referencing fields that are also referenced in the main clause are subsets
of the latter. Therefore we can rewrite the combined clause to ommit the more broad version from the main clause.
Assumes both filter clauses can be flattened by recursively merging | (defn inject-refinement
[filter-clause refinement]
(let [in-refinement? (into #{}
(map magic.util/collect-field-references)
(flatten-filter-clause refinement))
existing-filters (->> filter-clause
flatten-filter-clause
(remove (comp in-refinement? magic.util/collect-field-references)))]
(if (seq existing-filters)
;; since the filters are programatically generated they won't have passed thru normalization, so make sure we
;; normalize them before passing them to `combine-filter-clauses`, which validates its input
(apply mbql.u/combine-filter-clauses (map (partial mbql.normalize/normalize-fragment [:query :filter])
(cons refinement existing-filters)))
refinement))) |
Generate "interesting" inputs for the automatic dashboard pipeline. In this context, "interesting" means "grounded" values. In particular, the most interesting values of all are metrics. Metrics are intrinsically interesting and can be displayed on their own. Dimensions and filters, while not interesting on their own, can be combined with metrics to add more interest to the metric. In MBQL parlance, metrics are aggregates, dimensions are breakouts, and filters are filters. However, a user-defined metric may go beyond a simple aggregate. Our main namespace function, The template arguments are defined in terms of Dimensions, Metrics, and Filters. These are named values, such as: - Dimension: - GenericNumber - Timestamp - Country - Longitude - Latitude - Income - Discount - Metric: - Count - Dimensionless - Sum - A metric over a single field - AverageDiscount - A metric defined by the Income and Discount fields (as an example) - Filter: - Last30Days - A named quantity that is defined by one or more constituent Dimensions Template Metrics and Filters are made up of some combination of field references (Dimensions). These are referenced using the Dimension names (e.g. Avg of some GenericNumber) despite these constituent fields technically not being Dimensions. Metrics and Dimensions should be thought of as orthogonal concerns, but for our matching algorithm, this is how constituent fields are selected. The "grounding" process binds individual fields to named Dimensions as well as constituent elements of Filter and Metric definitions. Note that the binding process is 1:N, where a single dimension may match to multiple fields. A field can only bind to one dimension. | (ns metabase.automagic-dashboards.interesting
(:require
[clojure.math.combinatorics :as math.combo]
[clojure.string :as str]
[clojure.walk :as walk]
[java-time :as t]
[medley.core :as m]
[metabase.automagic-dashboards.dashboard-templates :as dashboard-templates]
[metabase.automagic-dashboards.schema :as ads]
[metabase.automagic-dashboards.util :as magic.util]
[metabase.mbql.normalize :as mbql.normalize]
[metabase.mbql.util :as mbql.u]
[metabase.models.field :as field :refer [Field]]
[metabase.models.interface :as mi]
[metabase.models.metric :refer [Metric]]
[metabase.models.table :refer [Table]]
[metabase.util :as u]
[metabase.util.date-2 :as u.date]
[metabase.util.malli :as mu]
[toucan2.core :as t2])) |
Code for creation of instantiated affinities | |
A utility function for pulling field definitions from mbql queries and return their IDs. Does something like this already exist in our utils? I was unable to find anything like it. | (defn find-field-ids
[m]
(let [fields (atom #{})]
(walk/prewalk
(fn [v]
(when (vector? v)
(let [[f id] v]
(when (and id (= :field f))
(swap! fields conj id))))
v)
m)
@fields)) |
From a :model/Metric, construct a mapping of semantic types of linked fields to sets of fields that can satisfy that type. A linked field is one that is in the source table for the metric contribute to the metric itself, is not a PK, and has a semantictype (we assume nil semantictype fields are boring). | (defn semantic-groups
[{:keys [table_id definition]}]
(let [field-ids (find-field-ids definition)
potential-dimensions (t2/select :model/Field
:id [:not-in field-ids]
:table_id table_id
:semantic_type [:not-in [:type/PK]])]
(update-vals
(->> potential-dimensions
(group-by :semantic_type))
set))) |
Map a metric aggregate definition from nominal types to semantic types. | (defn transform-metric-aggregate
[m decoder]
(walk/prewalk
(fn [v]
(if (vector? v)
(let [[d n] v]
(if (= "dimension" d)
(decoder n)
v))
v))
m)) |
(mu/defn ground-metric :- [:sequential ads/grounded-metric]
"Generate \"grounded\" metrics from the mapped dimensions (dimension name -> field matches).
Since there may be multiple matches to a dimension, this will produce a sequence of potential matches."
[{metric-name :metric-name
metric-score :score
metric-definition :metric} :- ads/normalized-metric-template
ground-dimensions :- ads/dim-name->matching-fields]
(let [named-dimensions (dashboard-templates/collect-dimensions metric-definition)]
(->> (map (comp :matches ground-dimensions) named-dimensions)
(apply math.combo/cartesian-product)
(map (partial zipmap named-dimensions))
(map (fn [nm->field]
(let [xform (update-vals nm->field (fn [{field-id :id}]
[:field field-id nil]))]
{:metric-name metric-name
:metric-title metric-name
:metric-score metric-score
:metric-definition {:aggregation
[(transform-metric-aggregate metric-definition xform)]}
;; Required for title interpolation in grounded-metrics->dashcards
:dimension-name->field nm->field})))))) | |
(mu/defn grounded-metrics :- [:sequential ads/grounded-metric] "Given a set of metric definitions and grounded (assigned) dimensions, produce a sequence of grounded metrics." [metric-templates :- [:sequential ads/normalized-metric-template] ground-dimensions :- ads/dim-name->matching-fields] (mapcat #(ground-metric % ground-dimensions) metric-templates)) | |
Utility function to convert a seq of maps of one string key to another map into a simpler seq of maps. | (defn normalize-seq-of-maps
[typename items]
(let [kw (keyword (format "%s-name" (name typename)))]
(->> items
(map first)
(map (fn [[name value]]
(assoc value kw name)))))) |
dimensions | |
Generate a predicate of the form (f field) -> truthy value based on a fieldspec. | (defn- fieldspec-matcher
[fieldspec]
(if (and (string? fieldspec)
(dashboard-templates/ga-dimension? fieldspec))
(comp #{fieldspec} :name)
(fn [{:keys [semantic_type target] :as field}]
(cond
;; This case is mostly relevant for native queries
(#{:type/PK :type/FK} fieldspec) (isa? semantic_type fieldspec)
target (recur target)
:else (and (not (magic.util/key-col? field)) (magic.util/field-isa? field fieldspec)))))) |
Generate a truthy predicate of the form (f field) -> truthy value based on a regex applied to the field name. | (defn- name-regex-matcher
[name-pattern]
(comp (->> name-pattern
u/lower-case-en
re-pattern
(partial re-find))
u/lower-case-en
:name)) |
Generate a predicate of the form (f field) -> true | false based on the provided cardinality. Returns true if the distinct count of fingerprint values is less than or equal to the cardinality. | (defn- max-cardinality-matcher
[cardinality]
(fn [field]
(some-> field
(get-in [:fingerprint :global :distinct-count])
(<= cardinality)))) |
(def ^:private field-filters
{:fieldspec fieldspec-matcher
:named name-regex-matcher
:max-cardinality max-cardinality-matcher}) | |
Find all fields belonging to table | (defn- filter-fields
[preds fields]
(filter (->> preds
(keep (fn [[k v]]
(when-let [pred (field-filters k)]
(some-> v pred))))
(apply every-pred))
fields)) |
Given a context and a dimension definition, find all fields from the context that match the definition of this dimension. | (defn- matching-fields
[{{:keys [fields]} :source :keys [tables] :as context}
{:keys [field_type links_to named max_cardinality] :as constraints}]
(if links_to
(filter (comp (->> (magic.util/filter-tables links_to tables)
(keep :link)
set)
u/the-id)
(matching-fields context (dissoc constraints :links_to)))
(let [[tablespec fieldspec] field_type]
(if fieldspec
(mapcat (fn [table]
(some->> table
:fields
(filter-fields {:fieldspec fieldspec
:named named
:max-cardinality max_cardinality})
(map #(assoc % :link (:link table)))))
(magic.util/filter-tables tablespec tables))
(filter-fields {:fieldspec tablespec
:named named
:max-cardinality max_cardinality}
fields))))) |
util candidate | (def ^:private ^{:arglists '([field])} id-or-name
(some-fn :id :name)) |
For every field in a given context determine all potential dimensions each field may map to. This will return a map of field id (or name) to collection of potential matching dimensions. | (defn- candidate-bindings
[context dimension-specs]
;; TODO - Fix this so that the intermediate representations aren't so crazy.
;; all-bindings a map of binding dim identifier to binding def which contains
;; field matches which are all the same field except they are merged with the binding.
;; What we want instead is just a map of field to potential bindings.
;; Just rack and stack the bindings then return that with the field or something.
(let [all-bindings (for [dimension dimension-specs
:let [[identifier definition] (first dimension)]
matching-field (matching-fields context definition)]
{(name identifier)
(assoc definition :matches [(merge matching-field definition)])})]
(group-by (comp id-or-name first :matches val first) all-bindings))) |
Assign a value to each potential binding.
Takes a seq of potential bindings and returns a seq of vectors in the shape
of [score binding], where score is a 3 element vector. This is computed as:
1) Number of ancestors | (defn- score-bindings
[candidate-binding-values]
(letfn [(score [a]
(let [[_ definition] a]
[(reduce + (map (comp count ancestors) (:field_type definition)))
(count definition)
(:score definition)]))]
(map (juxt (comp score first) identity) candidate-binding-values))) |
Return the most specific dimension from one or more dimensions that all
match the same field. Specificity is determined based on:
1) how many ancestors candidate-binding-values is a sequence of maps. Each map is a has a key of dimension spec name to potential dimension binding spec along with a collection of matches, all of which are merges of this spec with the same column. Note that it would make a lot more sense to refactor this to return a map of column to potential binding dimensions. This return value is kind of the opposite of what makes sense. Here's an example input with :matches updated as just the names of the columns in the matches. IRL, matches are the entire field n times, with each field a merge of the spec with the field. ({"Timestamp" {:field_type [:type/DateTime], :score 60, :matches ["CREATED_AT"]}} {"CreateTimestamp" {:field_type [:type/CreationTimestamp], :score 80 :matches ["CREATED_AT"]}}) | (defn- most-specific-matched-dimension
[candidate-binding-values]
(let [scored-bindings (score-bindings candidate-binding-values)]
(second (last (sort-by first scored-bindings))))) |
(mu/defn find-dimensions :- ads/dim-name->dim-defs+matches
"Bind fields to dimensions from the dashboard template and resolve overloaded cases in which multiple fields match the
dimension specification.
Each field will be bound to only one dimension. If multiple dimension definitions match a single field, the field
is bound to the most specific definition used
(see `most-specific-definition` for details).
The context is passed in, but it only needs tables and fields in `candidate-bindings`. It is not extensively used."
[context dimension-specs :- [:maybe [:sequential ads/dimension-template]]]
(->> (candidate-bindings context dimension-specs)
(map (comp most-specific-matched-dimension val))
(apply merge-with (fn [a b]
(case (compare (:score a) (:score b))
1 a
0 (update a :matches concat (:matches b))
-1 b))
{}))) | |
Get a reference for a given model to be injected into a template (either MBQL, native query, or string). | (defmulti
^{:doc
:arglists '([template-type model])}
->reference (fn [template-type model]
[template-type (mi/model model)])) |
(defn- optimal-datetime-resolution
[field]
(let [[earliest latest] (some->> field
:fingerprint
:type
:type/DateTime
((juxt :earliest :latest))
(map u.date/parse))]
(if (and earliest latest)
;; e.g. if 3 hours > [duration between earliest and latest] then use `:minute` resolution
(condp u.date/greater-than-period-duration? (u.date/period-duration earliest latest)
(t/hours 3) :minute
(t/days 7) :hour
(t/months 6) :day
(t/years 10) :month
:year)
:day))) | |
(defmethod ->reference [:mbql Field]
[_ {:keys [fk_target_field_id id link aggregation name base_type] :as field}]
(let [reference (mbql.normalize/normalize
(cond
link [:field id {:source-field link}]
fk_target_field_id [:field fk_target_field_id {:source-field id}]
id [:field id nil]
:else [:field name {:base-type base_type}]))]
(cond
(isa? base_type :type/Temporal)
(mbql.u/with-temporal-unit reference (keyword (or aggregation
(optimal-datetime-resolution field))))
(and aggregation
(isa? base_type :type/Number))
(mbql.u/update-field-options reference assoc-in [:binning :strategy] (keyword aggregation))
:else
reference))) | |
(defmethod ->reference [:string Field]
[_ {:keys [display_name full-name link]}]
(cond
full-name full-name
link (format "%s → %s"
(-> (t2/select-one Field :id link) :display_name (str/replace #"(?i)\sid$" ""))
display_name)
:else display_name)) | |
(defmethod ->reference [:string Table]
[_ {:keys [display_name full-name]}]
(or full-name display_name)) | |
(defmethod ->reference [:string Metric]
[_ {:keys [name full-name]}]
(or full-name name)) | |
(defmethod ->reference [:mbql Metric]
[_ {:keys [id definition]}]
(if id
[:metric id]
(-> definition :aggregation first))) | |
(defmethod ->reference [:native Field] [_ field] (field/qualified-name field)) | |
(defmethod ->reference [:native Table]
[_ {:keys [name]}]
name) | |
(defmethod ->reference :default
[_ form]
(or (cond-> form
(map? form) ((some-fn :full-name :name) form))
form)) | |
TODO - Deduplicate from core | (def ^:private ^{:arglists '([source])} source->db
(comp (partial t2/select-one :model/Database :id) (some-fn :db_id :database_id))) |
(defn- enriched-field-with-sources [{:keys [tables source]} field]
(assoc field
:link (m/find-first (comp :link #{(:table_id field)} u/the-id) tables)
:db (source->db source))) | |
(defn- add-field-links-to-definitions [dimensions field]
(->> dimensions
(keep (fn [[identifier definition]]
(when-let [matches (->> definition
:matches
(remove (comp #{(id-or-name field)} id-or-name))
not-empty)]
[identifier (assoc definition :matches matches)])))
(concat [["this" {:matches [field]
:name (:display_name field)
:score dashboard-templates/max-score
:card-score dashboard-templates/max-score}]])
(into {}))) | |
(defn- add-field-self-reference [{{:keys [entity]} :root :as context} dimensions]
(cond-> dimensions
(= Field (mi/model entity))
(add-field-links-to-definitions (enriched-field-with-sources context entity)))) | |
Take filter templates (as from a dashboard template's :filters) and ground dimensions and produce a map of the filter name to grounded versions of the filter. | (defn grounded-filters
[filter-templates ground-dimensions]
(->> filter-templates
(keep (fn [fltr]
(let [[fname {:keys [filter] :as v}] (first fltr)
dims (dashboard-templates/collect-dimensions v)
opts (->> (map (comp
(partial map (partial ->reference :mbql))
:matches
ground-dimensions) dims)
(apply math.combo/cartesian-product)
(map (partial zipmap dims)))]
(seq (for [opt opts
:let [f
(walk/prewalk
(fn [x]
(if (vector? x)
(let [[ds dim-name] x]
(if (and (= "dimension" ds)
(string? dim-name))
(opt dim-name)
x))
x))
filter)]]
(assoc v :filter f :filter-name fname))))))
flatten)) |
(mu/defn identify
:- [:map
[:dimensions ads/dim-name->matching-fields]
[:metrics [:sequential ads/grounded-metric]]]
"Identify interesting metrics and dimensions of a `thing`. First identifies interesting dimensions, and then
interesting metrics which are satisfied.
Metrics from the template are assigned a score of 50; user defined metrics a score of 95"
[{{:keys [linked-metrics]} :root :as context}
{:keys [dimension-specs
metric-specs
filter-specs]} :- [:map
[:dimension-specs [:maybe [:sequential ads/dimension-template]]]
[:metric-specs [:maybe [:sequential ads/metric-template]]]
[:filter-specs [:maybe [:sequential ads/filter-template]]]]]
(let [dims (->> (find-dimensions context dimension-specs)
(add-field-self-reference context))
metrics (-> (normalize-seq-of-maps :metric metric-specs)
(grounded-metrics dims))
set-score (fn [score metrics]
(map #(assoc % :metric-score score) metrics))]
{:dimensions dims
:metrics (concat (set-score 50 metrics) (set-score 95 linked-metrics)
(let [entity (-> context :root :entity)]
;; metric x-rays talk about "this" in the template
(when (mi/instance-of? :model/Metric entity)
[{:metric-name "this"
:metric-title (:name entity)
:metric-definition {:aggregation [(->reference :mbql entity)]}
:metric-score dashboard-templates/max-score}])))
:filters (grounded-filters filter-specs dims)})) | |
Convert a card to a dashboard card. | (defn card->dashcard
[{:keys [width height] :as card}]
{:id (gensym)
:size_x width
:size_y height
:dashboard_tab_id nil
:card (dissoc card :width :height)
:visualization_settings {}}) |
Assign | (defn make-layout
[dashcards]
(loop [[{:keys [size_x size_y] :as dashcard} & dashcards] dashcards
[xmin ymin xmax ymax] [0 0 0 0]
final-cards []]
(if dashcard
(let [dashcard (assoc dashcard :row ymin :col xmax)
bounds (if (> xmax 20)
[xmin ymax 0 (+ ymax size_y)]
[xmin ymin (+ xmax size_x) (max ymax (+ ymin size_y))])]
(recur dashcards
bounds
(conj final-cards dashcard)))
final-cards))) |
(ns metabase.automagic-dashboards.names (:require [clojure.string :as str] [java-time.api :as t] [metabase.automagic-dashboards.util :as magic.util] [metabase.mbql.normalize :as mbql.normalize] [metabase.mbql.util :as mbql.u] [metabase.query-processor.util :as qp.util] [metabase.util.date-2 :as u.date] [metabase.util.i18n :refer [deferred-tru tru]] [toucan2.core :as t2])) | |
TODO - rename "minumum" to "minimum". Note that there are internationalization string implications here so make sure to do a thorough find and replace on this. | (def ^:private op->name
{:sum (deferred-tru "sum")
:avg (deferred-tru "average")
:min (deferred-tru "minumum")
:max (deferred-tru "maximum")
:count (deferred-tru "number")
:distinct (deferred-tru "distinct count")
:stddev (deferred-tru "standard deviation")
:cum-count (deferred-tru "cumulative count")
:cum-sum (deferred-tru "cumulative sum")}) |
Return the name of the metric or name by describing it. | (defn metric-name
[[op & args :as metric]]
(cond
(mbql.u/ga-metric-or-segment? metric) (-> args first str (subs 3) str/capitalize)
(magic.util/adhoc-metric? metric) (-> op qp.util/normalize-token op->name)
(magic.util/saved-metric? metric) (->> args first (t2/select-one :model/Metric :id) :name)
:else (second args))) |
Join a sequence as [1 2 3 4] to "1, 2, 3 and 4" | (defn- join-enumeration
[xs]
(if (next xs)
(tru "{0} and {1}" (str/join ", " (butlast xs)) (last xs))
(first xs))) |
Return the (display) name of the source of a given root object. | (def ^{:arglists '([root])} source-name
(comp (some-fn :display_name :name) :source)) |
Return a description for the metric. | (defn metric->description
[root aggregation-clause]
(join-enumeration
(for [metric (if (sequential? (first aggregation-clause))
aggregation-clause
[aggregation-clause])]
(if (magic.util/adhoc-metric? metric)
(tru "{0} of {1}" (metric-name metric) (or (some->> metric
second
(magic.util/->field root)
:display_name)
(source-name root)))
(metric-name metric))))) |
Generate a description for the question. | (defn question-description
[root question]
(let [aggregations (->> (get-in question [:dataset_query :query :aggregation])
(metric->description root))
dimensions (->> (get-in question [:dataset_query :query :breakout])
(mapcat magic.util/collect-field-references)
(map (comp :display_name
(partial magic.util/->field root)))
join-enumeration)]
(if dimensions
(tru "{0} by {1}" aggregations dimensions)
aggregations))) |
(defmulti
^{:private true
:arglists '([fieldset [op & args]])}
humanize-filter-value (fn [_ [op & _args]]
(qp.util/normalize-token op))) | |
(def ^:private unit-name (comp {:minute-of-hour (deferred-tru "minute")
:hour-of-day (deferred-tru "hour")
:day-of-week (deferred-tru "day of week")
:day-of-month (deferred-tru "day of month")
:day-of-year (deferred-tru "day of year")
:week-of-year (deferred-tru "week")
:month-of-year (deferred-tru "month")
:quarter-of-year (deferred-tru "quarter")
:year (deferred-tru "year")}
qp.util/normalize-token)) | |
Turn a field reference into a field. | (defn item-reference->field
[root [item-type :as item-reference]]
(case item-type
(:field "field") (let [normalized-field-reference (mbql.normalize/normalize item-reference)
temporal-unit (mbql.u/match-one normalized-field-reference
[:field _ (opts :guard :temporal-unit)]
(:temporal-unit opts))
{:keys [display_name] :as field-record} (cond-> (->> normalized-field-reference
magic.util/collect-field-references
first
(magic.util/->field root))
temporal-unit
(assoc :unit temporal-unit))
item-name (cond->> display_name
(some-> temporal-unit u.date/extract-units)
(tru "{0} of {1}" (unit-name temporal-unit)))]
(assoc field-record :item-name item-name))
(:expression "expression") {:item-name (second item-reference)}
{:item-name "item"})) |
Determine the right name to display from an individual humanized item. | (defn item-name
([root [field-type potential-name :as field-reference]]
(case field-type
(:field "field") (->> field-reference (item-reference->field root) item-name)
(:expression "expression") potential-name
"item"))
([{:keys [display_name unit] :as _field}]
(cond->> display_name
(some-> unit u.date/extract-units) (tru "{0} of {1}" (unit-name unit))))) |
Add appropriate pluralization suffixes for integer numbers. | (defn pluralize
[x]
;; the `int` cast here is to fix performance warnings if `*warn-on-reflection*` is enabled
(case (int (mod x 10))
1 (tru "{0}st" x)
2 (tru "{0}nd" x)
3 (tru "{0}rd" x)
(tru "{0}th" x))) |
Convert a time data type into a human friendly string. | (defn humanize-datetime
[t-str unit]
(let [dt (u.date/parse t-str)]
(case unit
:second (tru "at {0}" (t/format "h:mm:ss a, MMMM d, YYYY" dt))
:minute (tru "at {0}" (t/format "h:mm a, MMMM d, YYYY" dt))
:hour (tru "at {0}" (t/format "h a, MMMM d, YYYY" dt))
:day (tru "on {0}" (t/format "MMMM d, YYYY" dt))
:week (tru "in {0} week - {1}"
(pluralize (u.date/extract dt :week-of-year))
(str (u.date/extract dt :year)))
:month (tru "in {0}" (t/format "MMMM YYYY" dt))
:quarter (tru "in Q{0} - {1}"
(u.date/extract dt :quarter-of-year)
(str (u.date/extract dt :year)))
:year (t/format "YYYY" dt)
:day-of-week (t/format "EEEE" dt)
:hour-of-day (tru "at {0}" (t/format "h a" dt))
:month-of-year (t/format "MMMM" dt)
:quarter-of-year (tru "Q{0}" (u.date/extract dt :quarter-of-year))
(:minute-of-hour
:day-of-month
:day-of-year
:week-of-year) (u.date/extract dt unit)))) |
(defmethod humanize-filter-value :=
[root [_ field-reference value]]
(let [{:keys [item-name effective_type base_type unit]} (item-reference->field root field-reference)]
(if (isa? (or effective_type base_type) :type/Temporal)
(tru "{0} is {1}" item-name (humanize-datetime value unit))
(tru "{0} is {1}" item-name value)))) | |
(defmethod humanize-filter-value :>=
[root [_ field-reference value]]
(let [{:keys [item-name effective_type base_type unit]} (item-reference->field root field-reference)]
(if (isa? (or effective_type base_type) :type/Temporal)
(tru "{0} is not before {1}" item-name (humanize-datetime value unit))
(tru "{0} is at least {1}" item-name value)))) | |
(defmethod humanize-filter-value :>
[root [_ field-reference value]]
(let [{:keys [item-name effective_type base_type unit]} (item-reference->field root field-reference)]
(if (isa? (or effective_type base_type) :type/Temporal)
(tru "{0} is after {1}" item-name (humanize-datetime value unit))
(tru "{0} is greater than {1}" item-name value)))) | |
(defmethod humanize-filter-value :<=
[root [_ field-reference value]]
(let [{:keys [item-name effective_type base_type unit]} (item-reference->field root field-reference)]
(if (isa? (or effective_type base_type) :type/Temporal)
(tru "{0} is not after {1}" item-name (humanize-datetime value unit))
(tru "{0} is no more than {1}" item-name value)))) | |
(defmethod humanize-filter-value :<
[root [_ field-reference value]]
(let [{:keys [item-name effective_type base_type unit]} (item-reference->field root field-reference)]
(if (isa? (or effective_type base_type) :type/Temporal)
(tru "{0} is before {1}" item-name (humanize-datetime value unit))
(tru "{0} is less than {1}" item-name value)))) | |
(defmethod humanize-filter-value :between
[root [_ field-reference min-value max-value]]
(tru "{0} is between {1} and {2}" (item-name root field-reference) min-value max-value)) | |
(defmethod humanize-filter-value :inside
[root [_ lat-reference lon-reference lat-max lon-min lat-min lon-max]]
(tru "{0} is between {1} and {2}; and {3} is between {4} and {5}"
(item-name root lon-reference) lon-min lon-max
(item-name root lat-reference) lat-min lat-max)) | |
(defmethod humanize-filter-value :and
[root [_ & clauses]]
(->> clauses
(map (partial humanize-filter-value root))
join-enumeration)) | |
(defmethod humanize-filter-value :default
[root [_ field-reference value]]
(let [{:keys [item-name effective_type base_type unit]} (item-reference->field root field-reference)]
(if (isa? (or effective_type base_type) :type/Temporal)
(tru "{0} relates to {1}" item-name (humanize-datetime value unit))
(tru "{0} relates to {1}" item-name value)))) | |
Return a cell title given a root object and a cell query. | (defn cell-title
[root cell-query]
(str/join " " [(if-let [aggregation (get-in root [:entity :dataset_query :query :aggregation])]
(metric->description root aggregation)
(:full-name root))
(tru "where {0}" (humanize-filter-value root cell-query))])) |
Create and save models that make up automagic dashboards. | (ns metabase.automagic-dashboards.populate (:require [clojure.string :as str] [medley.core :as m] [metabase.api.common :as api] [metabase.automagic-dashboards.filters :as filters] [metabase.automagic-dashboards.util :as magic.util] [metabase.models.card :as card] [metabase.models.collection :as collection] [metabase.public-settings :as public-settings] [metabase.query-processor.util :as qp.util] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
Total grid width. | (def ^Long grid-width 18) |
Default card width. | (def ^Long default-card-width 6) |
Default card height | (def ^Long default-card-height 4) |
Create and return a new collection. | (defn create-collection!
[title description parent-collection-id]
(first (t2/insert-returning-instances!
'Collection
(merge
{:name title
:description description}
(when parent-collection-id
{:location (collection/children-location (t2/select-one ['Collection :location :id]
:id parent-collection-id))}))))) |
Get or create container collection for automagic dashboards in the root collection. | (defn get-or-create-root-container-collection
[]
(or (t2/select-one 'Collection
:name "Automatically Generated Dashboards"
:location "/")
(create-collection! "Automatically Generated Dashboards" nil nil))) |
A vector of colors used for coloring charts. Uses [[public-settings/application-colors]] for user choices. | (defn colors
[]
(let [order [:brand :accent1 :accent2 :accent3 :accent4 :accent5 :accent6 :accent7]
colors-map (merge {:brand "#509EE3"
:accent1 "#88BF4D"
:accent2 "#A989C5"
:accent3 "#EF8C8C"
:accent4 "#F9D45C"
:accent5 "#F2A86F"
:accent6 "#98D9D9"
:accent7 "#7172AD"}
(public-settings/application-colors))]
(into [] (map colors-map) order))) |
(defn- ensure-distinct-colors
[candidates]
(->> candidates
frequencies
(reduce-kv
(fn [acc color count]
(if (= count 1)
(conj acc color)
(concat acc [color (first (drop-while (conj (set acc) color) (colors)))])))
[]))) | |
Map given objects to distinct colors. | (defn map-to-colors
[objs]
(->> objs
(map (comp (colors) #(mod % (count (colors))) hash))
ensure-distinct-colors)) |
Pick the chart colors acording to the following rules:
* If there is more than one breakout dimension let the frontend do it as presumably
the second dimension will be used as color key and we can't know the values it
will take at this stage.
* If the visualization is a bar or row chart with Colors are then determined by using the hashs of color keys to index into the vector of available colors. | (defn- colorize
[{:keys [visualization dataset_query]}]
(let [display (first visualization)
breakout (-> dataset_query :query :breakout)
aggregation (-> dataset_query :query :aggregation)]
(when (and (#{"line" "row" "bar" "scatter" "area"} display)
(= (count breakout) 1))
(let [color-keys (if (and (#{"bar" "row"} display)
(some->> aggregation
flatten
first
qp.util/normalize-token
(= :count)))
(->> breakout
magic.util/collect-field-references
(map magic.util/field-reference->id))
aggregation)]
{:graph.colors (map-to-colors color-keys)})))) |
(defn- visualization-settings
[{:keys [metrics x_label y_label series_labels visualization dimensions] :as card}]
(let [[display visualization-settings] visualization]
{:display display
:visualization_settings (-> visualization-settings
(assoc :graph.series_labels (map :name metrics)
:graph.metrics (map :op metrics)
:graph.dimensions dimensions)
(merge (colorize card))
(cond->
series_labels (assoc :graph.series_labels series_labels)
x_label (assoc :graph.x_axis.title_text x_label)
y_label (assoc :graph.y_axis.title_text y_label)))})) | |
Default properties for a dashcard on magic dashboard. | (defn card-defaults
[]
{:id (gensym)
:dashboard_tab_id nil
:visualization_settings {}}) |
Add a card to dashboard | (defn- add-card
[dashboard {:keys [title description dataset_query width height id] :as card} [x y]]
(let [card (-> {:creator_id api/*current-user-id*
:dataset_query dataset_query
:description description
:name title
:collection_id nil
:id (or id (gensym))}
(merge (visualization-settings card))
card/populate-query-fields)]
(update dashboard :dashcards conj
(merge (card-defaults)
{:col y
:row x
:size_x width
:size_y height
:card card
:card_id (:id card)
:visualization_settings {}})))) |
Add a text card to dashboard | (defn add-text-card
[dashboard {:keys [text width height visualization-settings]} [x y]]
(update dashboard :dashcards conj
(merge (card-defaults)
{:creator_id api/*current-user-id*
:visualization_settings (merge
{:text text
:virtual_card {:name nil
:display :text
:dataset_query {}
:visualization_settings {}}}
visualization-settings)
:col y
:row x
:size_x width
:size_y height
:card nil}))) |
(defn- make-grid [width height] (vec (repeat height (vec (repeat width false))))) | |
Mark a rectangular area starting at [ | (defn- fill-grid
[grid [x y] {:keys [width height]}]
(reduce (fn [grid xy]
(assoc-in grid xy true))
grid
(for [x (range x (+ x height))
y (range y (+ y width))]
[x y]))) |
Can we place card on grid starting at [x y] (top left corner)? Since we are filling the grid top to bottom and the cards are rectangulard, it suffices to check just the first (top) row. | (defn- accomodates?
[grid [x y] {:keys [width height]}]
(and (<= (+ x height) (count grid))
(<= (+ y width) (-> grid first count))
(every? false? (subvec (grid x) y (+ y width))))) |
Find position on the grid where to put the card. We use the dumbest possible algorithm (the grid size is relatively small, so we should be fine): startting at top left move along the grid from left to right, row by row and try to place the card at each position until we find an unoccupied area. Mark the area as occupied. | (defn- card-position
[grid start-row card]
(reduce (fn [grid xy]
(if (accomodates? grid xy card)
(reduced xy)
grid))
grid
(for [x (range start-row (count grid))
y (range (count (first grid)))]
[x y]))) |
Find the bottom of the grid. Bottom is the first completely empty row with another empty row below it. | (defn- bottom-row
[grid]
(let [row {:height 0, :width grid-width}]
(loop [bottom (long 0)]
(let [[bottom _] (card-position grid bottom row)
[next-bottom _] (card-position grid (inc bottom) row)]
(if (= (inc bottom) next-bottom)
bottom
(recur (long next-bottom))))))) |
(def ^:private ^{:arglists '([card])} text-card?
:text) | |
(def ^:private ^Long ^:const group-heading-height 2) | |
(defn- add-group
[dashboard grid group cards]
(let [start-row (bottom-row grid)
start-row (cond-> start-row
group (+ group-heading-height))]
(reduce (fn [[dashboard grid] card]
(let [xy (card-position grid start-row card)]
[(if (text-card? card)
(add-text-card dashboard card xy)
(add-card dashboard card xy))
(fill-grid grid xy card)]))
(if group
(let [xy [(- start-row 2) 0]
card {:text (format "# %s" (:title group))
:width grid-width
:height group-heading-height
:visualization-settings {:dashcard.background false
:text.align_vertical :bottom}}]
[(add-text-card dashboard card xy)
(fill-grid grid xy card)])
[dashboard grid])
cards))) | |
Pick up to | (defn- shown-cards
[max-cards cards]
(->> cards
(sort-by :card-score >)
(take max-cards)
(group-by (some-fn :group hash))
(map (fn [[_ group]]
{:cards (sort-by :position group)
:position (apply min (map :position group))}))
(sort-by :position)
(mapcat :cards))) |
(def ^:private ^:const ^Long max-filters 4) | |
A seq from a group-by in a particular order. If you don't need the map itself, just to get the key value pairs in a
particular order. Clojure's | (defn ordered-group-by-seq
[f key-order coll]
(letfn [(access [ks grouped]
(if (seq ks)
(let [k (first ks)]
(lazy-seq
(if-let [x (find grouped k)]
(cons x (access (next ks) (dissoc grouped k)))
(access (next ks) grouped))))
(seq grouped)))]
(let [g (group-by f coll)]
(access key-order g)))) |
Create dashboard and populate it with cards. | (defn create-dashboard
([dashboard] (create-dashboard dashboard :all))
([{:keys [title transient_title description groups filters cards]} n]
(let [n (cond
(= n :all) (count cards)
(keyword? n) (Integer/parseInt (name n))
:else n)
dashboard {:name title
:transient_name (or transient_title title)
:description description
:creator_id api/*current-user-id*
:parameters []}
cards (shown-cards n cards)
[dashboard _] (->> cards
(ordered-group-by-seq :group
(when groups
(sort-by (comp (fnil - 0) :score groups)
(keys groups))))
(reduce (fn [[dashboard grid] [group-name cards]]
(let [group (get groups group-name)]
(add-group dashboard grid group cards)))
[dashboard
;; Height doesn't need to be precise, just some
;; safe upper bound.
(make-grid grid-width (* n grid-width))]))]
(log/debug (trs "Adding {0} cards to dashboard {1}:\n{2}"
(count cards)
title
(str/join "; " (map :title cards))))
(cond-> (update dashboard :dashcards (partial sort-by (juxt :row :col)))
(not-empty filters) (filters/add-filters filters max-filters))))) |
(defn- downsize-titles
[markdown]
(->> markdown
str/split-lines
(map (fn [line]
(if (str/starts-with? line "#")
(str "#" line)
line)))
str/join)) | |
(defn- merge-filters
[ds]
(when (->> ds
(mapcat :dashcards)
(keep (comp :table_id :card))
distinct
count
(= 1))
[(->> ds (mapcat :parameters) distinct)
(->> ds
(mapcat :dashcards)
(mapcat :parameter_mappings)
(map #(dissoc % :card_id))
distinct)])) | |
Merge dashboards | (defn merge-dashboards
([target dashboard] (merge-dashboards target dashboard {}))
([target dashboard {:keys [skip-titles?]}]
(let [[parameters parameter-mappings] (merge-filters [target dashboard])
offset (->> target
:dashcards
(map #(+ (:row %) (:size_y %)))
(apply max -1) ; -1 so it neturalizes +1 for spacing
; if the target dashboard is empty.
inc)
cards (->> dashboard
:dashcards
(map #(-> %
(update :row + offset (if skip-titles?
0
group-heading-height))
(m/update-existing-in [:visualization_settings :text]
downsize-titles)
(assoc :parameter_mappings
(when-let [card-id (:card_id %)]
(for [mapping parameter-mappings]
(assoc mapping :card_id card-id)))))))]
(-> target
(assoc :parameters parameters)
(cond->
(not skip-titles?)
(add-text-card {:width grid-width
:height group-heading-height
:text (format "# %s" (:name dashboard))
:visualization-settings {:dashcard.background false
:text.align_vertical :bottom}}
[offset 0]))
(update :dashcards concat cards))))) |
(ns metabase.automagic-dashboards.schema
(:require [malli.core :as mc]
[malli.util :as mut])) | |
The big ball of mud data object from which we generate x-rays | (def context
(mc/schema
[:map
[:source any?]
[:root any?]
[:tables {:optional true} any?]
[:query-filter {:optional true} any?]])) |
The base unit thing we are trying to produce in x-rays | (def dashcard
;; TODO - Beef these specs up, esp. the any?s
(mc/schema
[:map
[:dataset_query {:optional true}
[:map
[:database {:optional true} [:maybe nat-int?]]
[:type :keyword]
[:query [:map
[:aggregation [:sequential any?]]
[:breakout {:optional true} [:sequential any?]]
[:source-table [:or :int :string]]]]]]
[:dimensions {:optional true} [:sequential string?]]
[:group {:optional true} string?]
[:height pos-int?]
[:metrics {:optional true} any?]
[:position {:optional true} nat-int?]
[:card-score {:optional true} number?]
[:total-score {:optional true} nat-int?]
[:metric-score {:optional true} nat-int?]
[:score-components {:optional true} [:sequential nat-int?]]
[:title {:optional true} string?]
[:visualization {:optional true} any?]
[:width pos-int?]
[:x_label {:optional true} string?]])) |
A bunch of dashcards | (def dashcards (mc/schema [:maybe [:sequential dashcard]])) |
A dimension reference, as either a semantic type or entity type and semantic type. | (def field-type
(mc/schema
[:or
[:tuple :keyword]
[:tuple :keyword :keyword]])) |
A specification for the basic keys in the value of a dimension template. | (def dimension-value
(mc/schema
[:map
[:field_type field-type]
[:score {:optional true} nat-int?]
[:max_cardinality {:optional true} nat-int?]
[:named {:optional true} [:string {:min 1}]]])) |
A specification for the basic keys in a dimension template. | (def dimension-template
(mc/schema
[:map-of
{:min 1 :max 1}
[:string {:min 1}]
dimension-value])) |
A specification for the basic keys in the value of a metric template. | (def metric-value
(mc/schema
[:map
[:metric [:vector some?]]
[:score {:optional true} nat-int?]
;[:name some?]
])) |
A specification for the basic keys in a metric template. | (def metric-template
(mc/schema
[:map-of
{:min 1 :max 1}
[:string {:min 1}]
metric-value])) |
A specification for the basic keys in the value of a filter template. | (def filter-value
(mc/schema
[:map
[:filter [:vector some?]]
[:score nat-int?]])) |
A specification for the basic keys in a filter template. | (def filter-template
(mc/schema
[:map-of
{:min 1 :max 1}
[:string {:min 1}]
filter-value])) |
A specification for the basic keys in the value of a card template. | (def card-value
(mc/schema
[:map
[:dimensions {:optional true} [:vector (mc/schema
[:map-of
{:min 1 :max 1}
[:string {:min 1}]
[:map
[:aggregation {:optional true} string?]]])]]
[:metrics {:optional true} [:vector string?]]
[:filters {:optional true} [:vector string?]]
[:card-score {:optional true} nat-int?]])) |
A specification for the basic keys in a card template. | (def card-template
(mc/schema
[:map-of
{:min 1 :max 1}
[:string {:min 1}]
card-value])) |
A specification for the basic keys in a dashboard template. | (def dashboard-template
(mc/schema
[:map
[:dimensions {:optional true} [:vector dimension-template]]
[:metrics {:optional true} [:vector metric-template]]
[:filters {:optional true} [:vector filter-template]]
[:cards {:optional true} [:vector card-template]]])) |
Available values schema -- These are items for which fields have been successfully bound | |
Specify the shape of things that are available after dimension to field matching for affinity matching | (def available-values
(mc/schema
[:map
[:available-dimensions [:map-of [:string {:min 1}] any?]]
[:available-metrics [:map-of [:string {:min 1}] any?]]
[:available-filters {:optional true} [:map-of [:string {:min 1}] any?]]])) |
Schemas for "affinity" functions as these can be particularly confusing | |
A set of dimensions that belong together. This is the basic unity of affinity. | (def dimension-set [:set string?]) |
A set of sematic types that belong together. This is the basic unity of semantic affinity. | (def semantic-affinity-set [:set :keyword]) |
A collection of things that go together. In this case, we're a bit specialized on
card affinity, but the key element in the structure is | (def affinity
(mc/schema
[:map
[:affinity-name :string]
[:affinity-set [:set :keyword]]
[:card-template card-value]
[:metric-constituent-names [:sequential :string]]
[:metric-field-types [:set :keyword]]
[:named-dimensions [:sequential :string]]
[:score {:optional true} nat-int?]])) |
A sequence of affinity objects. | (def affinities
(mc/schema
[:sequential affinity])) |
A collection of things that go together. In this case, we're a bit specialized on
card affinity, but the key element in the structure is | (def affinity-old
(mc/schema
[:map
[:dimensions {:optional true} [:vector string?]]
[:metrics {:optional true} [:vector string?]]
[:filters {:optional true} [:vector string?]]
[:score {:optional true} nat-int?]
[:affinity-name string?]
[:base-dims dimension-set]])) |
A sequence of affinity objects. | (def affinities-old
(mc/schema
[:sequential affinity-old])) |
A map of named affinities to all dimension sets that are associated with this name. | (def affinity-matches
(mc/schema
[:map-of
:string
[:vector dimension-set]])) |
A "thing" that we bind to, consisting, generally, of at least a name and id | (def item
(mc/schema
[:map
[:id {:optional true} nat-int?]
[:name {:optional true} string?]])) |
A map of dimension name to dimension definition. | (def dim-name->dim-def
(mc/schema
[:map-of :string dimension-value])) |
A map of named dimensions to a map containing the dimension data and a sequence of matching items satisfying this dimension | (def dim-name->matching-fields
(mc/schema
[:map-of :string
[:map
[:matches [:sequential item]]]])) |
The "full" grounded dimensions which matches dimension names to the dimension definition combined with matching fields. | (def dim-name->dim-defs+matches
(mut/merge
dim-name->dim-def
dim-name->matching-fields)) |
A map of dimension names to item satisfying that dimensions | (def dimension-map
(mc/schema
[:map-of :string item])) |
A sequence of dimension maps | (def dimension-maps
(mc/schema
[:sequential dimension-map])) |
A "normalized" metric template is a map containing the metric name as a key rather than a map of metric name to the map. | (def normalized-metric-template
(mc/schema
[:map
[:metric-name :string]
[:score nat-int?]
[:metric vector?]])) |
A metric containing a definition with actual field references/ids rather than dimension references. | (def grounded-metric
(mc/schema
[:map
[:metric-name :string]
[:metric-title :string]
[:metric-score nat-int?]
[:metric-definition
[:map
[:aggregation [:sequential any?]]]]])) |
A grounded metric in which the metric has been augmented with breakouts. | (def combined-metric
(mut/merge
grounded-metric
(mc/schema
[:map
[:metric-definition
[:map
[:aggregation [:sequential any?]]
[:breakout [:sequential any?]]]]]))) |
(comment (require '[malli.generator :as mg]) (mg/sample dashboard-template) (mg/sample affinities) (mg/sample affinity-matches) (mg/sample grounded-metric)) | |
(ns metabase.automagic-dashboards.util
(:require
[buddy.core.codecs :as codecs]
[cheshire.core :as json]
[clojure.string :as str]
[medley.core :as m]
[metabase.mbql.predicates :as mbql.preds]
[metabase.mbql.schema :as mbql.s]
[metabase.mbql.util :as mbql.u]
[metabase.models.field :refer [Field]]
[metabase.models.interface :as mi]
[metabase.sync.analyze.classify :as classify]
[metabase.util :as u]
[metabase.util.i18n :refer [trs]]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
#_{:clj-kondo/ignore [:deprecated-namespace]}
[metabase.util.schema :as su]
[ring.util.codec :as codec]
[schema.core :as s]
[toucan2.core :as t2])) | |
| (defn field-isa?
[{:keys [base_type semantic_type]} t]
(or (isa? (keyword semantic_type) t)
(isa? (keyword base_type) t))) |
Workaround for our leaky type system which conflates types with properties. | (defn key-col?
[{:keys [base_type semantic_type name]}]
(and (isa? base_type :type/Number)
(or (#{:type/PK :type/FK} semantic_type)
(let [name (u/lower-case-en name)]
(or (= name "id")
(str/starts-with? name "id_")
(str/ends-with? name "_id")))))) |
filter | (defn filter-tables [tablespec tables] (filter #(-> % :entity_type (isa? tablespec)) tables)) |
Is metric a saved metric? | (def ^{:arglists '([metric]) :doc } saved-metric?
(every-pred (partial mbql.u/is-clause? :metric)
(complement mbql.u/ga-metric-or-segment?))) |
Is this a custom expression? | (def ^{:arglists '([metric]) :doc } custom-expression?
(partial mbql.u/is-clause? :aggregation-options)) |
Is this an adhoc metric? | (def ^{:arglists '([metric]) :doc } adhoc-metric?
(complement (some-fn saved-metric? custom-expression?))) |
Encode given object as base-64 encoded JSON. | (def ^{:arglists '([x]) :doc "Base64 encode"} encode-base64-json
(comp codec/base64-encode codecs/str->bytes json/encode)) |
Is this a google analytics (ga) table? | (defn ga-table? [table] (isa? (:entity_type table) :entity/GoogleAnalyticsTable)) |
(s/defn field-reference->id :- (s/maybe (s/cond-pre su/NonBlankString su/IntGreaterThanZero)) "Extract field ID from a given field reference form." [clause] (mbql.u/match-one clause [:field id _] id)) | |
(mu/defn collect-field-references :- [:maybe [:sequential mbql.s/field]] "Collect all `:field` references from a given form." [form] (mbql.u/match form :field &match)) | |
(mu/defn ->field :- [:maybe (ms/InstanceOf Field)]
"Return `Field` instance for a given ID or name in the context of root."
[{{result-metadata :result_metadata} :source, :as root}
field-id-or-name-or-clause :- [:or ms/PositiveInt ms/NonBlankString [:fn mbql.preds/Field?]]]
(let [id-or-name (if (sequential? field-id-or-name-or-clause)
(field-reference->id field-id-or-name-or-clause)
field-id-or-name-or-clause)]
(or
;; Handle integer Field IDs.
(when (integer? id-or-name)
(t2/select-one Field :id id-or-name))
;; handle field string names. Only if we have result metadata. (Not sure why)
(when (string? id-or-name)
(when-not result-metadata
(log/warn (trs "Warning: Automagic analysis context is missing result metadata. Unable to resolve Fields by name.")))
(when-let [field (m/find-first #(= (:name %) id-or-name)
result-metadata)]
(as-> field field
(update field :base_type keyword)
(update field :semantic_type keyword)
(mi/instance Field field)
(classify/run-classifiers field {}))))
;; otherwise this isn't returning something, and that's probably an error. Log it.
(log/warn (str (trs "Cannot resolve Field {0} in automagic analysis context" field-id-or-name-or-clause)
\newline
(u/pprint-to-str root)))))) | |
(ns metabase.automagic-dashboards.visualization-macros) | |
Expand visualization macro. | (defmulti expand-visualization
(fn [card _ _]
(-> card :visualization first))) |
(def ^:private ^:const ^Long smart-row-table-threshold 10) | |
(defmethod expand-visualization "smart-row"
[card dimensions metrics]
(let [[_display settings] (:visualization card)]
(-> card
(assoc :visualization (if (->> dimensions
(keep #(get-in % [:fingerprint :global :distinct-count]))
(apply max 0)
(>= smart-row-table-threshold))
["row" settings]
["table" (merge {:column_settings {(->> metrics
first
:op
(format "[\"name\",\"%s\"]")
keyword) {:show_mini_bar true}}}
settings)]))
(update :order_by #(or % [{(-> card :metrics first) "descending"}]))))) | |
(defmethod expand-visualization :default [card _ _] card) | |
(ns metabase.bootstrap (:gen-class) (:require [clojure.java.io :as io])) | |
(set! *warn-on-reflection* true) | |
athena includes | (when-not (or (System/getProperty "log4j2.configurationFile")
(System/getProperty "log4j.configurationFile"))
;; if the test config file from `test_resources` is on the claspath, e.g. in `clj -X:dev:test`, use that.
(let [^String filename (if (io/resource "log4j2-test.xml")
"log4j2-test.xml"
"log4j2.xml")]
(System/setProperty "log4j2.configurationFile" filename))) |
ensure we use a | (System/setProperty "log4j2.contextSelector" "org.apache.logging.log4j.core.selector.BasicContextSelector") |
ensure the [[clojure.tools.logging]] logger factory is the log4j2 version (slf4j is far slower and identified first) | (System/setProperty "clojure.tools.logging.factory" "clojure.tools.logging.impl/log4j2-factory") |
Main entrypoint. Invokes [[metabase.core/entrypoint]] | (defn -main [& args] (apply (requiring-resolve 'metabase.core/entrypoint) args)) |
Functions for commands that can be ran from the command-line with the Clojure CLI or the Metabase JAR. These are ran as follows: for example, running the clojure -M:run migrate force java -jar metabase.jar migrate force Logic below translates resolves the command itself to a function marked with You can see what commands are available by running the command | (ns metabase.cmd (:refer-clojure :exclude [load import]) (:require [clojure.string :as str] [clojure.tools.cli :as cli] [environ.core :as env] [metabase.config :as config] [metabase.mbql.util :as mbql.u] [metabase.plugins.classloader :as classloader] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log])) |
(set! *warn-on-reflection* true) | |
Command processing and option parsing utilities, etc. | |
Proxy function to System/exit to enable the use of | (defn- system-exit! [return-code] (System/exit return-code)) |
Looks up a command var by name | (defn- cmd->var [command-name] (ns-resolve 'metabase.cmd (symbol command-name))) |
Resolves enterprise command by symbol and calls with args, or else throws error if not EE | (defn- call-enterprise
[symb & args]
(let [f (try
(classloader/require (symbol (namespace symb)))
(or (resolve symb)
(throw (ex-info (trs "{0} does not exist" symb) {})))
(catch Throwable e
(throw (ex-info (trs "The ''{0}'' command is only available in Metabase Enterprise Edition." (name symb))
{:command symb}
e))))]
(apply f args))) |
(defn- get-parsed-options [iref options] (:options (cli/parse-opts options (:arg-spec (meta iref))))) | |
Command implementations | |
Run database migrations. Valid options for | (defn ^:command migrate [direction] (classloader/require 'metabase.cmd.migrate) ((resolve 'metabase.cmd.migrate/migrate!) direction)) |
Transfer data from existing H2 database to the newly created MySQL or Postgres DB specified by env vars. | (defn ^:command load-from-h2 ([] (load-from-h2 nil)) ([h2-connection-string] (classloader/require 'metabase.cmd.load-from-h2) ((resolve 'metabase.cmd.load-from-h2/load-from-h2!) h2-connection-string))) |
(defn ^:command dump-to-h2
{:doc "Transfer data from existing database to newly created H2 DB with specified filename.
Target H2 file is deleted before dump, unless the --keep-existing flag is given."
:arg-spec [["-k" "--keep-existing" "Do not delete target H2 file if it exists."
:id :keep-existing?]
["-p" "--dump-plaintext" "Do not encrypt dumped contents."
:id :dump-plaintext?]]}
[h2-filename & opts]
(classloader/require 'metabase.cmd.dump-to-h2)
(try
(let [options (get-parsed-options #'dump-to-h2 opts)]
((resolve 'metabase.cmd.dump-to-h2/dump-to-h2!) h2-filename options)
(println "Dump complete")
(system-exit! 0))
(catch Throwable e
(log/error e "Failed to dump application database to H2 file")
(system-exit! 1)))) | |
Start Metabase the usual way and exit. Useful for profiling Metabase launch time. | (defn ^:command profile [] ;; override env var that would normally make Jetty block forever (alter-var-root #'env/env assoc :mb-jetty-join "false") (u/profile "start-normally" ((resolve 'metabase.core/start-normally)))) |
Reset the password for a user with | (defn ^:command reset-password [email-address] (classloader/require 'metabase.cmd.reset-password) ((resolve 'metabase.cmd.reset-password/reset-password!) email-address)) |
Show this help message listing valid Metabase commands. | (defn ^:command help
([command-name]
(let [{:keys [doc arg-spec arglists]} (meta (cmd->var command-name))]
(doseq [arglist arglists]
(apply println command-name arglist))
(when doc
(doseq [doc-line (str/split doc #"\n\s+")]
(println "\t" doc-line)))
(when arg-spec
(println "\t" "Options:")
(doseq [opt-line (str/split (:summary (cli/parse-opts [] arg-spec)) #"\n")]
(println "\t" opt-line)))))
([]
(println "Valid commands are:")
(doseq [[symb varr] (sort (ns-interns 'metabase.cmd))
:when (:command (meta varr))]
(help symb)
(println))
(println "\nSome other commands you might find useful:\n")
(println "java -cp metabase.jar org.h2.tools.Shell -url jdbc:h2:/path/to/metabase.db")
(println "\tOpen an SQL shell for the Metabase H2 DB"))) |
Print version information about Metabase and the current system. | (defn ^:command version
[]
(println "Metabase version:" config/mb-version-info)
(println "\nOS:"
(System/getProperty "os.name")
(System/getProperty "os.version")
(System/getProperty "os.arch"))
(println "\nJava version:"
(System/getProperty "java.vm.name")
(System/getProperty "java.version"))
(println "\nCountry:" (System/getProperty "user.country"))
(println "System timezone:" (System/getProperty "user.timezone"))
(println "Language:" (System/getProperty "user.language"))
(println "File encoding:" (System/getProperty "file.encoding"))) |
Generate a markdown file containing documentation for all API endpoints. This is written to a file called
| (defn ^:command api-documentation [] (classloader/require 'metabase.cmd.endpoint-dox) ((resolve 'metabase.cmd.endpoint-dox/generate-dox!))) |
Generates a markdown file containing documentation for environment variables relevant to configuring Metabase. The command only includes environment variables registered as defsettings. For a full list of environment variables, see https://www.metabase.com/docs/latest/configuring-metabase/environment-variables. | (defn ^:command environment-variables-documentation [] (classloader/require 'metabase.cmd.env-var-dox) ((resolve 'metabase.cmd.env-var-dox/generate-dox!))) |
Print a list of all multimethods available for a driver to implement, optionally with their docstrings. | (defn ^:command driver-methods ([] (classloader/require 'metabase.cmd.driver-methods) ((resolve 'metabase.cmd.driver-methods/print-available-multimethods) false)) ([_docs] (classloader/require 'metabase.cmd.driver-methods) ((resolve 'metabase.cmd.driver-methods/print-available-multimethods) true))) |
(defn ^:command load
{:doc "Note: this command is deprecated. Use `import` instead.
Load serialized Metabase instance as created by [[dump]] command from directory `path`."
:arg-spec [["-m" "--mode (skip|update)" "Update or skip on conflicts."
:default :skip
:default-desc "skip"
:parse-fn mbql.u/normalize-token
:validate [#{:skip :update} "Must be 'skip' or 'update'"]]
["-e" "--on-error (continue|abort)" "Abort or continue on error."
:default :continue
:default-desc "continue"
:parse-fn mbql.u/normalize-token
:validate [#{:continue :abort} "Must be 'continue' or 'abort'"]]]}
[path & options]
(log/warn (u/colorize :red (trs "''load'' is deprecated and will be removed in a future release. Please migrate to ''import''.")))
(call-enterprise 'metabase-enterprise.serialization.cmd/v1-load! path (get-parsed-options #'load options))) | |
(defn ^:command import
{:doc "Load serialized Metabase instance as created by the [[export]] command from directory `path`."
:arg-spec [["-e" "--abort-on-error" "Stops import on any errors, default is to continue."]]}
[path & options]
(call-enterprise 'metabase-enterprise.serialization.cmd/v2-load! path (get-parsed-options #'import options))) | |
(defn ^:command dump
{:doc "Note: this command is deprecated. Use `export` instead.
Serializes Metabase instance into directory `path`."
:arg-spec [["-u" "--user EMAIL" "Export collections owned by the specified user"]
["-s" "--state (active|all)" "When set to `active`, do not dump archived entities. Default behavior is `all`."
:default :all
:default-desc "all"
:parse-fn mbql.u/normalize-token
:validate [#{:active :all} "Must be 'active' or 'all'"]]]}
[path & options]
(log/warn (u/colorize :red (trs "''dump'' is deprecated and will be removed in a future release. Please migrate to ''export''.")))
(call-enterprise 'metabase-enterprise.serialization.cmd/v1-dump! path (get-parsed-options #'dump options))) | |
(defn ^:command export
{:doc "Serialize Metabase instance into directory at `path`."
:arg-spec [["-c" "--collection ID" "Export only specified ID(s). Use commas to separate multiple IDs."
:id :collection-ids
:parse-fn (fn [raw-string] (map parse-long (str/split raw-string #"\s*,\s*")))]
["-C" "--no-collections" "Do not export any content in collections."]
["-S" "--no-settings" "Do not export settings.yaml"]
["-D" "--no-data-model" "Do not export any data model entities; useful for subsequent exports."]
["-f" "--include-field-values" "Include field values along with field metadata."]
["-s" "--include-database-secrets" "Include database connection details (in plain text; use caution)."]]}
[path & options]
(call-enterprise 'metabase-enterprise.serialization.cmd/v2-dump! path (get-parsed-options #'export options))) | |
Add entity IDs for instances of serializable models that don't already have them. | (defn ^:command seed-entity-ids
[]
(when-not (call-enterprise 'metabase-enterprise.serialization.cmd/seed-entity-ids!)
(throw (Exception. "Error encountered while seeding entity IDs")))) |
Drop entity IDs for instances of serializable models. Useful for migrating from v1 serialization (x.46 and earlier) to v2 (x.47+). | (defn ^:command drop-entity-ids
[]
(when-not (call-enterprise 'metabase-enterprise.serialization.cmd/drop-entity-ids!)
(throw (Exception. "Error encountered while dropping entity IDs")))) |
Rotate the encryption key of a metabase database. The MBENCRYPTIONSECRET_KEY environment variable has to be set to
the current key, and the parameter | (defn ^:command rotate-encryption-key
[new-key]
(classloader/require 'metabase.cmd.rotate-encryption-key)
(try
((resolve 'metabase.cmd.rotate-encryption-key/rotate-encryption-key!) new-key)
(log/info "Encryption key rotation OK.")
(system-exit! 0)
(catch Throwable _e
(log/error "ERROR ROTATING KEY.")
(system-exit! 1)))) |
------------------------------------------------ Validate Commands ---------------------------------------------- | |
(defn- arg-list-count-ok? [arg-list arg-count]
(if (some #{'&} arg-list)
;; subtract 1 for the & and 1 for the symbol after &
;; e.g. [a b & c] => 2
(>= arg-count (- (count arg-list) 2))
(= arg-count (count arg-list)))) | |
(defn- arg-count-errors
[command-name args]
(let [arg-lists (-> command-name cmd->var meta :arglists)]
(when-not (some #(arg-list-count-ok? % (count args)) arg-lists)
(str "The '" command-name "' command requires "
(when (> 1 (count arg-lists)) "one of ")
"the following arguments: "
(str/join " | " (map pr-str arg-lists))
", but received: " (pr-str (vec args)) ".")))) | |
------------------------------------------------ Running Commands ------------------------------------------------ | |
Returns [error-message] if there is an error, otherwise [nil command-fn] | (defn- validate
[command-name args]
(let [varr (cmd->var command-name)
{:keys [command arg-spec]} (meta varr)
err (arg-count-errors command-name args)]
(cond
(not command)
[(str "Unrecognized command: '" command-name "'")
(str "Valid commands: " (str/join ", " (map key (filter (comp :command meta val) (ns-interns 'metabase.cmd)))))]
err
[err]
arg-spec
(:errors (cli/parse-opts args arg-spec))))) |
(defn- fail!
[& messages]
(doseq [msg messages]
(println (u/format-color 'red msg)))
(System/exit 1)) | |
Run | (defn run-cmd
[command-name args]
(if-let [errors (validate command-name args)]
(do
(when (cmd->var command-name)
(println "Usage:")
(help command-name))
(apply fail! errors))
(try
(apply @(cmd->var command-name) args)
(catch Throwable e
(.printStackTrace e)
(fail! (str "Command failed with exception: " (.getMessage e))))))
(System/exit 0)) |
Shared lower-level implementation of the [[metabase.cmd.dump-to-h2/dump-to-h2!]] and [[metabase.cmd.load-from-h2/load-from-h2!]] commands. The [[copy!]] function implemented here supports loading data from an application database to any empty application database for all combinations of supported application database types. | (ns metabase.cmd.copy
(:require
[clojure.java.jdbc :as jdbc]
[honey.sql :as sql]
[metabase.config :as config]
[metabase.db.connection :as mdb.connection]
#_{:clj-kondo/ignore [:deprecated-namespace]}
[metabase.db.setup :as mdb.setup]
[metabase.plugins.classloader :as classloader]
[metabase.util :as u]
[metabase.util.i18n :refer [trs]]
[metabase.util.log :as log]
[schema.core :as s]
[toucan2.core :as t2])
(:import
(java.sql SQLException))) |
(set! *warn-on-reflection* true) | |
(defn- log-ok [] (log/info (u/colorize 'green "[OK]"))) | |
(defn- do-step [msg f]
(log/info (str (u/colorize 'blue msg) " "))
(try
(f)
(catch Throwable e
(log/error (u/colorize 'red "[FAIL]\n"))
(throw (ex-info (trs "ERROR {0}: {1}" msg (ex-message e))
{}
e))))
(log-ok)) | |
Convenience for executing | (defmacro ^:private step
{:style/indent 1}
[msg & body]
`(do-step ~msg (fn [] ~@body))) |
Entities in the order they should be serialized/deserialized. This is done so we make sure that we load
instances of entities before others that might depend on them, e.g. | (def entities
(concat
[:model/Database
:model/User
:model/Setting
:model/Table
:model/Field
:model/FieldValues
:model/Segment
:model/Metric
:model/MetricImportantField
:model/ModerationReview
:model/Revision
:model/ViewLog
:model/Session
:model/Collection
:model/CollectionPermissionGraphRevision
:model/Dashboard
:model/Card
:model/CardBookmark
:model/DashboardBookmark
:model/CollectionBookmark
:model/BookmarkOrdering
:model/DashboardCard
:model/DashboardCardSeries
:model/Activity
:model/Pulse
:model/PulseCard
:model/PulseChannel
:model/PulseChannelRecipient
:model/PermissionsGroup
:model/PermissionsGroupMembership
:model/Permissions
:model/PermissionsRevision
:model/PersistedInfo
:model/ApplicationPermissionsRevision
:model/Dimension
:model/NativeQuerySnippet
:model/LoginHistory
:model/Timeline
:model/TimelineEvent
:model/Secret
:model/ParameterCard
:model/Action
:model/ImplicitAction
:model/HTTPAction
:model/QueryAction
:model/DashboardTab
:model/ModelIndex
:model/ModelIndexValue
;; 48+
:model/TablePrivileges
:model/AuditLog
:model/RecentViews]
(when config/ee-available?
[:model/GroupTableAccessPolicy
:model/ConnectionImpersonation]))) |
Given a sequence of objects/rows fetched from the H2 DB, return a the | (defn- objects->colums+values
[target-db-type objs]
;; Need to wrap the column names in quotes because Postgres automatically lowercases unquoted identifiers. (This
;; should be ok now that #16344 is resolved -- we might be able to remove this code entirely now. Quoting identifiers
;; is still a good idea tho.)
(let [source-keys (keys (first objs))
quote-fn (partial mdb.setup/quote-for-application-db (mdb.connection/quoting-style target-db-type))
dest-keys (for [k source-keys]
(quote-fn (name k)))]
{:cols dest-keys
:vals (for [row objs]
(map row source-keys))})) |
(def ^:private chunk-size 100) | |
Insert of | (defn- insert-chunk!
[target-db-type target-db-conn-spec table-name chunkk]
(log/debugf "Inserting chunk of %d rows" (count chunkk))
(try
(let [{:keys [cols vals]} (objects->colums+values target-db-type chunkk)]
(jdbc/insert-multi! target-db-conn-spec table-name cols vals {:transaction? false}))
(catch SQLException e
(log/error (with-out-str (jdbc/print-sql-exception-chain e)))
(throw e)))) |
Whether [[copy-data!]] (and thus [[metabase.cmd.load-from-h2/load-from-h2!]]) should copy connection details for H2 Databases from the source application database. Normally disabled for security reasons. This is only here so we can disable this check for tests. | (def ^:dynamic *copy-h2-database-details* false) |
(defn- model-select-fragment
[model]
(case model
:model/Field {:order-by [[:id :asc]]}
nil)) | |
(defn- sql-for-selecting-instances-from-source-db [model]
(first
(sql/format
(merge {:select [[:*]]
:from [[(t2/table-name model)]]}
(model-select-fragment model))
{:quoted false}))) | |
(defn- model-results-xform [model]
(case model
:model/Database
;; For security purposes, do NOT copy connection details for H2 Databases by default; replace them with an empty map.
;; Why? Because this is a potential pathway to injecting sneaky H2 connection parameters that cause RCEs. For the
;; Sample Database, the correct details are reset automatically on every
;; launch (see [[metabase.sample-data/update-sample-database-if-needed!]]), and we don't support connecting other H2
;; Databases in prod anyway, so this ultimately shouldn't cause anyone any problems.
(if *copy-h2-database-details*
identity
(map (fn [database]
(cond-> database
(= (:engine database) "h2") (assoc :details "{}")))))
;; else
identity)) | |
(defn- copy-data! [^javax.sql.DataSource source-data-source target-db-type target-db-conn-spec]
(with-open [source-conn (.getConnection source-data-source)]
(doseq [model entities
:let [table-name (t2/table-name model)
sql (sql-for-selecting-instances-from-source-db model)
results (jdbc/reducible-query {:connection source-conn} sql)]]
(transduce
(comp (model-results-xform model)
(partition-all chunk-size))
;; cnt = the total number we've inserted so far
;; chunkk = current chunk to insert
(fn
([cnt]
(when (pos? cnt)
(log/info (str " " (u/colorize 'green (trs "copied {0} instances." cnt))))))
([cnt chunkk]
(when (seq chunkk)
(when (zero? cnt)
(log/info (u/colorize 'blue (trs "Copying instances of {0}..." (name model)))))
(try
(insert-chunk! target-db-type target-db-conn-spec table-name chunkk)
(catch Throwable e
(throw (ex-info (trs "Error copying instances of {0}" (name model))
{:model (name model)}
e)))))
(+ cnt (count chunkk))))
0
results)))) | |
Make sure [target] application DB is empty before we start copying data. | (defn- assert-db-empty
[data-source]
;; check that there are no Users yet
(let [[{:keys [cnt]}] (jdbc/query {:datasource data-source} "SELECT count(*) AS cnt FROM core_user;")]
(assert (integer? cnt))
(when (pos? cnt)
(throw (ex-info (trs "Target DB is already populated!")
{}))))) |
(defn- do-with-connection-rollback-only [conn f] (jdbc/db-set-rollback-only! conn) (f) (jdbc/db-unset-rollback-only! conn)) | |
Make database transaction connection | (defmacro ^:private with-connection-rollback-only
{:style/indent 1}
[conn & body]
`(do-with-connection-rollback-only ~conn (fn [] ~@body))) |
(defmulti ^:private disable-db-constraints!
{:arglists '([db-type conn-spec])}
(fn [db-type _]
db-type)) | |
(defmethod disable-db-constraints! :postgres
[_ conn]
;; make all of our FK constraints deferrable. This only works on Postgres 9.4+ (December 2014)! (There's no pressing
;; reason to turn these back on at the conclusion of this script. It makes things more complicated since it doesn't
;; work if done inside the same transaction.)
(doseq [{constraint :constraint_name, table :table_name} (jdbc/query
conn
[(str "SELECT * "
"FROM information_schema.table_constraints "
"WHERE constraint_type = 'FOREIGN KEY'")])]
(jdbc/execute! conn [(format "ALTER TABLE \"%s\" ALTER CONSTRAINT \"%s\" DEFERRABLE" table constraint)]))
;; now enable constraint deferring for the duration of the transaction
(jdbc/execute! conn ["SET CONSTRAINTS ALL DEFERRED"])) | |
(defmethod disable-db-constraints! :mysql [_ conn] (jdbc/execute! conn ["SET FOREIGN_KEY_CHECKS=0"])) | |
(defmethod disable-db-constraints! :h2 [_ conn] (jdbc/execute! conn "SET REFERENTIAL_INTEGRITY FALSE")) | |
(defmulti ^:private reenable-db-constraints!
{:arglists '([db-type conn-spec])}
(fn [db-type _]
db-type)) | |
(defmethod reenable-db-constraints! :default [_ _]) ; no-op | |
For MySQL we need to re-enable FK checks when we're done | (defmethod reenable-db-constraints! :mysql [_ conn] (jdbc/execute! conn ["SET FOREIGN_KEY_CHECKS=1"])) |
(defmethod reenable-db-constraints! :h2 [_ conn] (jdbc/execute! conn "SET REFERENTIAL_INTEGRITY TRUE")) | |
(defn- do-with-disabled-db-constraints [db-type conn f]
(step (trs "Temporarily disabling DB constraints...")
(disable-db-constraints! db-type conn))
(try
(f)
(finally
(step (trs "Re-enabling DB constraints...")
(reenable-db-constraints! db-type conn))))) | |
Disable foreign key constraints for the duration of | (defmacro ^:private with-disabled-db-constraints
{:style/indent 2}
[db-type conn & body]
`(do-with-disabled-db-constraints ~db-type ~conn (fn [] ~@body))) |
Make sure the target database is empty -- rows created by migrations (such as the magic permissions groups and default perms entries) need to be deleted so we can copy everything over from the source DB without running into conflicts. | (defn- clear-existing-rows!
[target-db-type ^javax.sql.DataSource target-data-source]
(with-open [conn (.getConnection target-data-source)
stmt (.createStatement conn)]
(with-disabled-db-constraints target-db-type {:connection conn}
(try
(.setAutoCommit conn false)
(let [save-point (.setSavepoint conn)]
(try
(letfn [(add-batch! [^String sql]
(log/debug (u/colorize :yellow sql))
(.addBatch stmt sql))]
;; do these in reverse order so child rows get deleted before parents
(doseq [table-name (map t2/table-name (reverse entities))]
(add-batch! (format (if (= target-db-type :postgres)
"TRUNCATE TABLE %s CASCADE;"
"TRUNCATE TABLE %s;")
(name table-name)))))
(.executeBatch stmt)
(.commit conn)
(catch Throwable e
(try
(.rollback conn save-point)
(catch Throwable e2
(throw (Exception. (ex-message e2) e))))
(throw e))))
(finally
(.setAutoCommit conn true)))))) |
Entities that do NOT use an auto incrementing ID column. | (def ^:private entities-without-autoinc-ids
#{:model/Setting
:model/Session
:model/ImplicitAction
:model/HTTPAction
:model/QueryAction
:model/ModelIndexValue
:model/TablePrivileges}) |
(defmulti ^:private postgres-id-sequence-name
{:arglists '([model])}
keyword) | |
(defmethod postgres-id-sequence-name :default [model] (str (name (t2/table-name model)) "_id_seq")) | |
we changed the table name to | (defmethod postgres-id-sequence-name :model/GroupTableAccessPolicy [_model] "group_table_access_policy_id_seq") |
(defmulti ^:private update-sequence-values!
{:arglists '([db-type data-source])}
(fn [db-type _]
db-type)) | |
(defmethod update-sequence-values! :default [_ _]) ; no-op | |
Update the sequence nextvals. | (defmethod update-sequence-values! :postgres
[_db-type data-source]
#_{:clj-kondo/ignore [:discouraged-var]}
(jdbc/with-db-transaction [target-db-conn {:datasource data-source}]
(step (trs "Setting Postgres sequence ids to proper values...")
(doseq [model entities
:when (not (contains? entities-without-autoinc-ids model))
:let [table-name (name (t2/table-name model))
seq-name (postgres-id-sequence-name model)
sql (format "SELECT setval('%s', COALESCE((SELECT MAX(id) FROM %s), 1), true) as val"
seq-name (name table-name))]]
(try
(jdbc/db-query-with-resultset target-db-conn [sql] :val)
(catch Throwable e
(throw (ex-info (format "Error updating sequence values for %s: %s" model (ex-message e))
{:model model}
e)))))))) |
(defmethod update-sequence-values! :h2
[_db-type data-source]
#_{:clj-kondo/ignore [:discouraged-var]}
(jdbc/with-db-transaction [target-db-conn {:datasource data-source}]
(step (trs "Setting H2 sequence ids to proper values...")
(doseq [e entities
:when (not (contains? entities-without-autoinc-ids e))
:let [table-name (name (t2/table-name e))
sql (format "ALTER TABLE %s ALTER COLUMN ID RESTART WITH COALESCE((SELECT MAX(ID) + 1 FROM %s), 1)"
table-name table-name)]]
(jdbc/execute! target-db-conn sql))))) | |
Copy data from a source application database into an empty destination application database. | (s/defn copy!
[source-db-type :- (s/enum :h2 :postgres :mysql)
source-data-source :- javax.sql.DataSource
target-db-type :- (s/enum :h2 :postgres :mysql)
target-data-source :- javax.sql.DataSource]
;; make sure the entire system is loaded before running this test, to make sure we account for all the models.
(doseq [ns-symb u/metabase-namespace-symbols]
(classloader/require ns-symb))
;; make sure the source database is up-do-date
(step (trs "Set up {0} source database and run migrations..." (name source-db-type))
(mdb.setup/setup-db! source-db-type source-data-source true))
;; make sure the dest DB is up-to-date
;;
;; don't need or want to run data migrations in the target DB, since the data is already migrated appropriately
(step (trs "Set up {0} target database and run migrations..." (name target-db-type))
(mdb.setup/setup-db! target-db-type target-data-source true))
;; make sure target DB is empty
(step (trs "Testing if target {0} database is already populated..." (name target-db-type))
(assert-db-empty target-data-source))
;; clear any rows created by the Liquibase migrations.
(step (trs "Clearing default entries created by Liquibase migrations...")
(clear-existing-rows! target-db-type target-data-source))
;; create a transaction and load the data.
#_{:clj-kondo/ignore [:discouraged-var]}
(jdbc/with-db-transaction [target-conn-spec {:datasource target-data-source}]
;; transaction should be set as rollback-only until it completes. Only then should we disable rollback-only so the
;; transaction will commit (i.e., only commit if the whole thing succeeds)
(with-connection-rollback-only target-conn-spec
;; disable FK constraints for the duration of loading data.
(with-disabled-db-constraints target-db-type target-conn-spec
(copy-data! source-data-source target-db-type target-conn-spec))))
;; finally, update sequence values (if needed)
(update-sequence-values! target-db-type target-data-source)) |
Functions for working with H2 databases shared between the | (ns metabase.cmd.copy.h2 (:require [clojure.java.io :as io] [clojure.string :as str] [metabase.db.data-source :as mdb.data-source] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log])) |
(set! *warn-on-reflection* true) | |
(defn- add-file-prefix-if-needed [h2-filename]
(letfn [(prepend-protocol [s]
(str "file:" (.getAbsolutePath (io/file s))))
(remove-extension [s]
(str/replace s #"\.mv\.db$" ))]
(cond-> h2-filename
(not (str/starts-with? h2-filename "file:"))
prepend-protocol
(str/ends-with? h2-filename ".mv.db")
remove-extension))) | |
Create a [[javax.sql.DataSource]] for the H2 database with | (defn h2-data-source
^javax.sql.DataSource [h2-filename]
(let [h2-filename (add-file-prefix-if-needed h2-filename)]
(mdb.data-source/broken-out-details->DataSource :h2 {:db h2-filename}))) |
Delete existing h2 database files. | (defn delete-existing-h2-database-files!
[h2-filename]
(doseq [filename [h2-filename
(str h2-filename ".mv.db")]]
(when (.exists (io/file filename))
(io/delete-file filename)
(log/warn (u/format-color 'red (trs "Output H2 database already exists: %s, removing.") filename))))) |
(ns metabase.cmd.driver-methods (:require [clojure.java.classpath :as classpath] [clojure.string :as str] [clojure.tools.namespace.find :as ns.find] [metabase.plugins.classloader :as classloader] [metabase.util :as u])) | |
(defn- driver-ns-symbs []
(sort
(for [ns-symb (ns.find/find-namespaces (classpath/system-classpath))
:let [starts-with? (partial str/starts-with? (name ns-symb))]
:when (and (or (starts-with? "metabase.driver")
(starts-with? "metabase.test.data"))
(do
(u/ignore-exceptions (classloader/require ns-symb))
(find-ns ns-symb)))]
ns-symb))) | |
(defn- available-multimethods
([]
(for [ns-symb (driver-ns-symbs)
:let [multimethods (available-multimethods ns-symb)]
:when (seq multimethods)]
[(ns-name ns-symb) multimethods]))
([ns-symb]
(sort
(for [[symb varr] (ns-publics ns-symb)
:when (instance? clojure.lang.MultiFn @varr)]
[symb varr])))) | |
Print a list of all multimethods available for a driver to implement, and maybe their docstrings. | (defn print-available-multimethods
[docstring]
(doseq [[namespc multimethods] (available-multimethods)]
(println (u/format-color 'blue namespc))
(doseq [[symb varr] multimethods]
(println (str/join " " (cons (u/format-color 'green symb) (:arglists (meta varr)))))
(when docstring (println (:doc (meta varr)) "\n"))))) |
Commands for dumping data to an H2 file from app database. Run this as follows (h2 filename is optional): clojure -M:run dump-to-h2 '/path/to/metabase.db/' or java -jar metabase.jar dump-to-h2 Validate with: clojure -M:run load-from-h2 '"/path/to/metabase.db"' | (ns metabase.cmd.dump-to-h2 (:require [metabase.cmd.copy :as copy] [metabase.cmd.copy.h2 :as copy.h2] [metabase.cmd.rotate-encryption-key :as rotate-encryption] [metabase.db.connection :as mdb.connection] [metabase.util.log :as log])) |
Transfer data from existing database specified by connection string to the H2 DB specified by env vars. Intended as a tool for migrating from one instance to another using H2 as serialization target. Defaults to using [[metabase.db.env/db-file]] as the connection string. Target H2 DB will be deleted if it exists, unless | (defn dump-to-h2!
([h2-filename]
(dump-to-h2! h2-filename nil))
([h2-filename {:keys [keep-existing? dump-plaintext?]
:or {keep-existing? false dump-plaintext? false}}]
(let [h2-filename (or h2-filename "metabase_dump.h2")
h2-data-source (copy.h2/h2-data-source h2-filename)]
(log/infof "Dumping from configured Metabase db to H2 file %s" h2-filename)
(when-not keep-existing?
(copy.h2/delete-existing-h2-database-files! h2-filename))
(copy/copy! (mdb.connection/db-type) (mdb.connection/data-source) :h2 h2-data-source)
(when dump-plaintext?
(binding [mdb.connection/*application-db* (mdb.connection/application-db :h2 h2-data-source)]
(rotate-encryption/rotate-encryption-key! nil)))))) |
Implementation for the | (ns metabase.cmd.endpoint-dox (:require [clojure.java.classpath :as classpath] [clojure.java.io :as io] [clojure.string :as str] [clojure.tools.namespace.find :as ns.find] [metabase.config :as config] [metabase.plugins.classloader :as classloader] [metabase.util :as u])) |
API docs intro | |
Exists just so we can write the intro in Markdown. | (defn- api-docs-intro [] (str (slurp "src/metabase/cmd/resources/api-intro.md") "\n\n")) |
API docs page title | |
Some paid endpoints have different formatting. This way we don't combine the api/table endpoint with sandbox.api.table, for example. | (defn- handle-enterprise-ns
[endpoint]
(if (str/includes? endpoint "metabase-enterprise")
(str/split endpoint #"metabase-enterprise.")
(str/split endpoint #"\."))) |
Used to format initialisms/acronyms in generated docs. | (def initialisms '["SSO" "SAML" "GTAP" "LDAP" "SQL" "JSON" "API"]) |
Converts initialisms to upper case. | (defn capitalize-initialisms
[name initialisms]
(let [re (re-pattern (str "(?i)(?:" (str/join "|" (map #(str % "\\b") initialisms)) ")"))]
(str/replace name re u/upper-case-en))) |
Creates a name for endpoints in a namespace, like all the endpoints for Alerts. Handles some edge cases for enterprise endpoints. | (defn- endpoint-ns-name
[endpoint]
(-> (:ns endpoint)
ns-name
name
handle-enterprise-ns
last
u/capitalize-first-char
(str/replace #"(.api.|-)" " ")
(capitalize-initialisms initialisms)
(str/replace "SSO SSO" "SSO"))) |
Used for formatting YAML string punctuation for frontmatter descriptions. | (defn- handle-quotes
[s]
(-> s
(str/replace #"\"" "'")
str/split-lines
(#(str/join "\n " %)))) |
Formats description for YAML frontmatter. | (defn- format-frontmatter-description [desc] (str "|\n " (handle-quotes desc))) |
Used to grab namespace description, if it exists. | (defn- get-description
[ep ep-data]
(let [desc (-> ep-data
first
:ns
meta
:doc
u/add-period)]
(if (str/blank? desc)
(u/add-period (str "API endpoints for " ep))
desc))) |
Formats frontmatter, which includes title and summary, if any. | (defn- endpoint-page-frontmatter
[ep ep-data]
(let [desc (format-frontmatter-description (get-description ep ep-data))]
(str "---\ntitle: \"" ep "\""
"\nsummary: " desc "\n---\n\n"))) |
Creates a page title for a set of endpoints, e.g., | (defn- endpoint-page-title [ep-title] (str "# " ep-title "\n\n")) |
API endpoint description | |
If there is a namespace docstring, include the docstring with a paragraph break. | (defn- endpoint-page-description
[ep ep-data]
(let [desc (get-description ep ep-data)]
(if (str/blank? desc)
desc
(str desc "\n\n")))) |
API endpoints | |
Creates a name for an endpoint: VERB /path/to/endpoint. Used to build anchor links in the table of contents. | (defn- endpoint-str
[endpoint]
(-> (:doc endpoint)
(str/split #"\n")
first
str/trim)) |
Decorates endpoints with strings for building API endpoint pages. | (defn- process-endpoint
[endpoint]
(assoc endpoint
:endpoint-str (endpoint-str endpoint)
:ns-name (endpoint-ns-name endpoint))) |
(defn- api-namespaces []
(for [ns-symb (ns.find/find-namespaces (classpath/system-classpath))
:when (and (re-find #"^metabase(?:-enterprise\.[\w-]+)?\.api\." (name ns-symb))
(not (str/includes? (name ns-symb) "test")))]
ns-symb)) | |
Gets a list of all API endpoints. | (defn- collect-endpoints
[]
(for [ns-symb (api-namespaces)
[_sym varr] (do (classloader/require ns-symb)
(sort (ns-interns ns-symb)))
:when (:is-endpoint? (meta varr))]
(meta varr))) |
Builds a list of endpoints and their parameters.
Relies on docstring generation in | (defn- endpoint-docs [ep-data] (str/join "\n\n" (map #(str/trim (:doc %)) ep-data))) |
Is the endpoint a paid feature? | (defn- paid?
[ep-data]
(or (str/includes? (:endpoint-str (first ep-data)) "/api/ee")
;; some ee endpoints are inconsistent in naming, see #22687
(str/includes? (:endpoint-str (first ep-data)) "/api/mt")
(= 'metabase-enterprise.sandbox.api.table (ns-name (:ns (first ep-data))))
(str/includes? (:endpoint-str (first ep-data)) "/auth/sso")
(str/includes? (:endpoint-str (first ep-data)) "/api/moderation-review"))) |
Adds a footer with a link back to the API index. | (defn endpoint-footer
[ep-data]
(let [level (if (paid? ep-data) "../../" "../")]
(str "\n\n---\n\n[<< Back to API index](" level "api-documentation.md)"))) |
Build API pages | |
Builds a page with the name, description, table of contents for endpoints in a namespace, followed by the endpoint and their parameter descriptions. | (defn endpoint-page
[ep ep-data]
(apply str
(endpoint-page-frontmatter ep ep-data)
(endpoint-page-title ep)
(endpoint-page-description ep ep-data)
(endpoint-docs ep-data)
(endpoint-footer ep-data))) |
Creates a filepath from an endpoint. | (defn- build-filepath
[dir endpoint-name ext]
(let [file (-> endpoint-name
str/trim
(str/split #"\s+")
(#(str/join "-" %))
u/lower-case-en)]
(str dir file ext))) |
Creates a link to the page for each endpoint. Used to build links
on the API index page at | (defn build-endpoint-link
[ep ep-data]
(let [filepath (build-filepath (if (paid? ep-data) "api/ee/" "api/") ep ".md")]
(str "- [" ep (when (paid? ep-data) "*") "](" filepath ")"))) |
Creates a string that lists links to all endpoint groups, e.g., - Activity. | (defn- build-index [endpoints] (str/join "\n" (map (fn [[ep ep-data]] (build-endpoint-link ep ep-data)) endpoints))) |
Creates a sorted map of API endpoints. Currently includes some endpoints for paid features. | (defn- map-endpoints
[]
(->> (collect-endpoints)
(map process-endpoint)
(group-by :ns-name)
(into (sorted-map)))) |
Page generators | |
Creates an index page that lists links to all endpoint pages. | (defn- generate-index-page!
[endpoint-map]
(let [endpoint-index (str
(api-docs-intro)
(build-index endpoint-map))]
(spit (io/file "docs/api-documentation.md") endpoint-index))) |
Takes a map of endpoint groups and generates markdown pages for all API endpoint groups. | (defn- generate-endpoint-pages!
[endpoints]
(doseq [[ep ep-data] endpoints]
(let [file (build-filepath (str "docs/" (if (paid? ep-data) "api/ee/" "api/")) ep ".md")
contents (endpoint-page ep ep-data)]
(io/make-parents file)
(spit file contents)))) |
Is it a markdown file? | (defn- md?
[file]
(= "md"
(-> file
str
(str/split #"\.")
last))) |
Used to clear the API directory for rebuilding docs from scratch so we don't orphan files as the API changes. | (defn- reset-dir
[file]
(let [files (filter md? (file-seq file))]
(doseq [f files]
(try (io/delete-file f)
(catch Exception e
(println "File:" f "not deleted")
(println e)))))) |
Builds an index page and sub-pages for groups of endpoints.
Index page is | (defn generate-dox!
[]
(when-not config/ee-available?
(println (u/colorize
:red (str "Warning: EE source code not available. EE endpoints will not be included. "
"If you want to include them, run the command with"
\newline
\newline
"clojure -M:ee:run api-documentation"))))
(let [endpoint-map (map-endpoints)]
(reset-dir (io/file "docs/api"))
(generate-index-page! endpoint-map)
(println "API doc index generated at docs/api-documentation.md.")
(generate-endpoint-pages! endpoint-map)
(println "API endpoint docs generated in docs/api/{endpoint}."))) |
Code to generate docs for environment variables. You can generate
docs by running: | (ns metabase.cmd.env-var-dox (:require [clojure.java.classpath :as classpath] [clojure.java.io :as io] [clojure.string :as str] [clojure.tools.namespace.find :as ns.find] [clojure.tools.reader.edn :as edn] [metabase.models.setting :as setting] [metabase.util :as u])) |
Flamber advises that people avoid touching these environment variables. | (def env-vars-not-to-mess-with (set (edn/read-string (slurp (io/resource "metabase/cmd/resources/env-vars-to-avoid.edn"))))) |
Loads all of the metabase namespaces, which loads all of the defsettings, which are registered in an atom in the settings namespace. Once settings are registered, This function derefs that atom and puts the settings into a sorted map for processing. | (defn get-settings
[]
(doseq [ns-symb (ns.find/find-namespaces (classpath/system-classpath))
:when (and
(str/includes? (name ns-symb) "metabase")
(not (str/includes? (name ns-symb) "test")))]
(require ns-symb))
(->> @setting/registered-settings
(into (sorted-map))
seq
(map (fn [[_ v]] v)))) |
Formatting functions | |
Helper function to specify the format of an environment variable's type for its documentation. | (defn- format-type [env-var] (str "Type: " (name (:type env-var)))) |
Helper function to specify how to format the default value of an enviromnent variable. for use in the environment variable docs. | (defn- format-default
[env-var]
(let [d (:default env-var)]
(str "Default: "
(if (false? d) "`false`"
(if (:default env-var)
(str "`" (:default env-var) "`")
"`null`"))))) |
Used to build an environment variable. | (defn- format-prefix [env-var] (str "MB_" (u/->SCREAMING_SNAKE_CASE_EN (name (:name env-var))))) |
Takes an integer and a string and creates a Markdown heading of level n. | (defn- format-heading [n s] (str (apply str (take n (repeat "#"))) " `" s "`")) |
Helper function to specify description format for enviromnent variable docs. | (defn- format-description
[env-var]
(->> (:description env-var)
u/add-period
;; Drop brackets used to create source code links
(#(str/replace % #"\[\[|\]\]" "")))) |
Used to specify when the environment variable was added, if that info exists. | (defn format-added
[env-var]
(when-let [a (:added (:doc env-var))]
(str "Added: " a))) |
Includes additional documentation for an environment variable ( | (defn- format-doc
[env-var]
(when-let [d (:doc env-var)]
(:commentary d))) |
Preps a doc entry for an environment variable as a Markdown section. | (defn format-env-var-entry
[env-var]
(str/join "\n\n" (remove str/blank?
[(format-heading 3 (format-prefix env-var))
(format-type env-var)
(format-default env-var)
(format-added env-var)
(format-description env-var)
(format-doc env-var)]))) |
Filter functions | |
Used to filter out environment variables with high foot-gun indices. | (defn- avoid?
[env-var]
(or (false? (:doc env-var))
;; Ideally, we'd move off of this list completely, but not all environment variables
;; are defsettings.
(contains? env-vars-not-to-mess-with (format-prefix env-var)))) |
Used to filter out environment variables that cannot be set. | (defn- setter? [env-var] (not= :none (:setter env-var))) |
Used to filter our deprecated enviroment variables. | (defn- active? [env-var] (nil? (:deprecated env-var))) |
Preps relevant environment variable docs as a Markdown string. | (defn format-env-var-docs
[settings]
(->> settings
(filter setter?)
(filter active?)
(remove avoid?)
(map format-env-var-entry))) |
Exists just so we can write the intro in Markdown. | (defn- format-intro [] (str (slurp "src/metabase/cmd/resources/env-var-intro.md") "\n\n")) |
Prints the generated environment variable docs to a file. | (defn generate-dox!
[]
(println "Generating docs for environment variables...")
(spit (io/file "docs/configuring-metabase/environment-variables.md") (apply str (format-intro)
(str/join "\n\n" (format-env-var-docs (get-settings)))))
(println "Done.")) |
Commands for loading data from an H2 file into another database. Run this with clojure -M:run load-from-h2 or java -jar metabase.jar load-from-h2 Test this as follows: # Postgres psql -c 'DROP DATABASE IF EXISTS metabase;' psql -c 'CREATE DATABASE metabase;' MBDBTYPE=postgres MBDBHOST=localhost MBDBPORT=5432 MBDBUSER=camsaul MBDBDBNAME=metabase clojure -M:run load-from-h2 # MySQL mysql -u root -e 'DROP DATABASE IF EXISTS metabase; CREATE DATABASE metabase;' MBDBTYPE=mysql MBDBHOST=localhost MBDBPORT=3305 MBDBUSER=root MBDBDBNAME=metabase clojure -M:run load-from-h2 | (ns metabase.cmd.load-from-h2 (:require [metabase.cmd.copy :as copy] [metabase.cmd.copy.h2 :as copy.h2] [metabase.db.connection :as mdb.connection] [metabase.db.env :as mdb.env])) |
Transfer data from existing H2 database to a newly created (presumably MySQL or Postgres) DB. Intended as a tool for upgrading from H2 to a 'real' database. Defaults to using [[metabase.db.env/db-file]] as the source H2 database if | (defn load-from-h2!
([]
(load-from-h2! (mdb.env/db-file)))
([h2-filename]
(let [h2-filename (str h2-filename ";IFEXISTS=TRUE")
h2-data-source (copy.h2/h2-data-source h2-filename)]
(copy/copy! :h2 h2-data-source (mdb.connection/db-type) (mdb.connection/data-source))))) |
(ns metabase.cmd.migrate (:require [metabase.db.connection :as mdb.connection] [metabase.db.setup :as mdb.setup])) | |
Migrate the Metabase application DB. | (defn migrate! [direction] (mdb.setup/migrate! (mdb.connection/db-type) (mdb.connection/data-source) (keyword direction))) |
(ns metabase.cmd.reset-password (:require [metabase.db :as mdb] [metabase.models.user :as user :refer [User]] [metabase.util :as u] [metabase.util.i18n :refer [deferred-trs trs]] [toucan2.core :as t2])) | |
(set! *warn-on-reflection* true) | |
Set and return a new | (defn- set-reset-token!
[email-address]
(let [user-id (or (t2/select-one-pk User, :%lower.email (u/lower-case-en email-address))
(throw (Exception. (str (deferred-trs "No user found with email address ''{0}''. " email-address)
(deferred-trs "Please check the spelling and try again.")))))]
(user/set-password-reset-token! user-id))) |
Reset the password for EMAIL-ADDRESS, and return the reset token in a format that can be understood by the Mac App. | (defn reset-password!
[email-address]
(mdb/setup-db!)
(println (str (deferred-trs "Resetting password for {0}..." email-address)
"\n"))
(try
(println (trs "OK [[[{0}]]]" (set-reset-token! email-address)))
(System/exit 0)
(catch Throwable e
(println (trs "FAIL [[[{0}]]]" (.getMessage e)))
(System/exit -1)))) |
(ns metabase.cmd.rotate-encryption-key (:require [cheshire.core :as json] [metabase.db :as mdb] [metabase.db.connection :as mdb.connection] [metabase.db.env :as mdb.env] [metabase.models :refer [Database Secret Setting]] [metabase.models.setting.cache :as setting.cache] [metabase.util.encryption :as encryption] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [toucan2.core :as t2])) | |
Rotate the current configured db using the current | (defn rotate-encryption-key!
[to-key]
(when-not (mdb/db-is-set-up?)
(log/warnf "Database not found. Metabase will create a new database at %s and proceeed encrypting." "2")
(mdb/setup-db!))
(log/infof "%s: %s | %s" (trs "Connected to") mdb.env/db-type (mdb.env/db-file))
(let [make-encrypt-fn (fn [maybe-encrypt-fn]
(if to-key
(partial maybe-encrypt-fn (encryption/validate-and-hash-secret-key to-key))
identity))
encrypt-str-fn (make-encrypt-fn encryption/maybe-encrypt)
encrypt-bytes-fn (make-encrypt-fn encryption/maybe-encrypt-bytes)]
(t2/with-transaction [t-conn {:datasource (mdb.connection/data-source)}]
(doseq [[id details] (t2/select-pk->fn :details Database)]
(when (encryption/possibly-encrypted-string? details)
(throw (ex-info (trs "Can''t decrypt app db with MB_ENCRYPTION_SECRET_KEY") {:database-id id})))
(t2/update! :conn t-conn :metabase_database
{:id id}
{:details (encrypt-str-fn (json/encode details))}))
(doseq [[key value] (t2/select-fn->fn :key :value Setting)]
(if (= key "settings-last-updated")
(setting.cache/update-settings-last-updated!)
(t2/update! :conn t-conn :setting
{:key key}
{:value (encrypt-str-fn value)})))
;; update all secret values according to the new encryption key
;; fortunately, we don't need to fetch the latest secret instance per ID, as we would need to in order to update
;; a secret value through the regular database save API path; instead, ALL secret values in the app DB (regardless
;; of whether they are the "current version" or not), should be updated with the new key
(doseq [[id value] (t2/select-pk->fn :value Secret)]
(when (encryption/possibly-encrypted-string? value)
(throw (ex-info (trs "Can''t decrypt secret value with MB_ENCRYPTION_SECRET_KEY") {:secret-id id})))
(t2/update! :conn t-conn :secret
{:id id}
{:value (encrypt-bytes-fn value)}))))) |
(ns metabase.config (:require [cheshire.core :as json] [clojure.java.io :as io] [clojure.string :as str] [environ.core :as env] [metabase.plugins.classloader :as classloader]) (:import (clojure.lang Keyword))) | |
(set! *warn-on-reflection* true) | |
Indicates whether Enterprise Edition extensions are available this existed long before 0.39.0, but that's when it was made public | (def ^{:doc :added "0.39.0"} ee-available?
(try
(classloader/require 'metabase-enterprise.core)
true
(catch Throwable _
false))) |
Whether code from | (def tests-available?
(try
(classloader/require 'metabase.test.core)
true
(catch Throwable _
false))) |
Are we running on a Windows machine? | (def ^Boolean is-windows?
#_{:clj-kondo/ignore [:discouraged-var]}
(str/includes? (str/lower-case (System/getProperty "os.name")) "win")) |
Global application defaults | (def ^:private app-defaults
{:mb-run-mode "prod"
;; DB Settings
:mb-db-type "h2"
:mb-db-file "metabase.db"
:mb-db-automigrate "true"
:mb-db-logging "true"
;; Jetty Settings. Full list of options is available here: https://github.com/ring-clojure/ring/blob/master/ring-jetty-adapter/src/ring/adapter/jetty.clj
:mb-jetty-port "3000"
:mb-jetty-join "true"
;; other application settings
:mb-password-complexity "normal"
:mb-version-info-url "https://static.metabase.com/version-info.json"
:mb-version-info-ee-url "https://static.metabase.com/version-info-ee.json"
:mb-ns-trace "" ; comma-separated namespaces to trace
:max-session-age "20160" ; session length in minutes (14 days)
:mb-colorize-logs (str (not is-windows?)) ; since PowerShell and cmd.exe don't support ANSI color escape codes or emoji,
:mb-emoji-in-logs (str (not is-windows?)) ; disable them by default when running on Windows. Otherwise they're enabled
:mb-qp-cache-backend "db"}) |
separate map for EE stuff so merge conflicts aren't annoying. | (def ^:private ee-app-defaults
{:embed-max-session-age "1440"}) ; how long a FULL APP EMBED session is valid for. One day, by default |
(alter-var-root #'app-defaults merge ee-app-defaults) | |
Retrieve value for a single configuration key. Accepts either a keyword or a string. We resolve properties from these places:
| (defn config-str
[k]
(let [k (keyword k)
env-val (k env/env)]
(or (when-not (str/blank? env-val) env-val)
(k app-defaults)))) |
Fetch a configuration key and parse it as an integer. These are convenience functions for accessing config values that ensures a specific return type TODO - These names are bad. They should be something like Fetch a configuration key and parse it as a boolean. Fetch a configuration key and parse it as a keyword. | (defn config-int ^Integer [k] (some-> k config-str Integer/parseInt)) (defn config-bool ^Boolean [k] (some-> k config-str Boolean/parseBoolean)) (defn config-kw ^Keyword [k] (some-> k config-str keyword)) |
Are we running in Are we running in Are we running in | (def ^Boolean is-dev? (= :dev (config-kw :mb-run-mode))) (def ^Boolean is-prod? (= :prod (config-kw :mb-run-mode))) (def ^Boolean is-test? (= :test (config-kw :mb-run-mode))) |
Version stuff | |
(defn- version-info-from-properties-file []
(when-let [props-file (io/resource "version.properties")]
(with-open [reader (io/reader props-file)]
(let [props (java.util.Properties.)]
(.load props reader)
(into {} (for [[k v] props]
[(keyword k) v])))))) | |
Information about the current version of Metabase. Comes from mb-version-info -> {:tag: "v0.11.1", :hash: "afdf863", :date: "2015-10-05"} TODO - Can we make this | (def mb-version-info
(or (version-info-from-properties-file)
;; if version info is not defined for whatever reason
{:tag "vLOCAL_DEV"
:hash "06d1ba2ae111e66253209c01c244d6379acfc6dcb1911fa9ab6012cec9ce52e5"})) |
A formatted version string representing the currently running application.
Looks something like | (def ^String mb-version-string
(let [{:keys [tag hash]} mb-version-info]
(format "%s (%s)" tag hash))) |
A formatted version string including the word 'Metabase' appropriate for passing along
with database connections so admins can identify them as Metabase ones.
Looks something like | (def ^String mb-app-id-string (str "Metabase " (mb-version-info :tag))) |
Returns the major version of the running Metabase JAR. When the version.properties file is missing (e.g., running in local dev), returns nil. | (defn current-major-version
[]
(some-> (second (re-find #"\d+\.(\d+)" (:tag mb-version-info)))
parse-long)) |
This UUID is randomly-generated upon launch and used to identify this specific Metabase instance during
this specifc run. Restarting the server will change this UUID, and each server in a horizontal cluster
will have its own ID, making this different from the | (defonce local-process-uuid (str (random-uuid))) |
A string that contains identifying information about the Metabase version and the local process. | (defonce mb-version-and-process-identifier (format "%s [%s]" mb-app-id-string local-process-uuid)) |
Default user details provided as a JSON string at launch time for first-user setup flow. | (defn mb-user-defaults
[]
(when-let [user-json (env/env :mb-user-defaults)]
(json/parse-string user-json true))) |
The user-id of the internal metabase user. This is needed in the OSS edition to filter out users for setup/has-user-setup. | (def ^:const internal-mb-user-id 13371338) |
(ns metabase.core (:require [clojure.string :as str] [clojure.tools.trace :as trace] [java-time.api :as t] [metabase.analytics.prometheus :as prometheus] [metabase.config :as config] [metabase.core.config-from-file :as config-from-file] [metabase.core.initialization-status :as init-status] [metabase.db :as mdb] [metabase.driver.h2] [metabase.driver.mysql] [metabase.driver.postgres] [metabase.events :as events] [metabase.logger :as logger] [metabase.models.setting :as settings] [metabase.plugins :as plugins] [metabase.plugins.classloader :as classloader] [metabase.public-settings :as public-settings] [metabase.public-settings.premium-features :refer [defenterprise]] [metabase.sample-data :as sample-data] [metabase.server :as server] [metabase.server.handler :as handler] [metabase.setup :as setup] [metabase.task :as task] [metabase.troubleshooting :as troubleshooting] [metabase.util :as u] [metabase.util.i18n :refer [deferred-trs trs]] [metabase.util.log :as log]) (:import (java.lang.management ManagementFactory))) | |
(set! *warn-on-reflection* true) | |
(comment ;; Load up the drivers shipped as part of the main codebase, so they will show up in the list of available DB types metabase.driver.h2/keep-me metabase.driver.mysql/keep-me metabase.driver.postgres/keep-me ;; Make sure the custom Metabase logger code gets loaded up so we use our custom logger for performance reasons. logger/keep-me) | |
don't i18n this, it's legalese | (log/info
(format "\nMetabase %s" config/mb-version-string)
(format "\n\nCopyright © %d Metabase, Inc." (.getYear (java.time.LocalDate/now)))
(str "\n\n"
(if config/ee-available?
(str (deferred-trs "Metabase Enterprise Edition extensions are PRESENT.")
"\n\n"
(deferred-trs "Usage of Metabase Enterprise Edition features are subject to the Metabase Commercial License.")
" "
(deferred-trs "See {0} for details." "https://www.metabase.com/license/commercial/"))
(deferred-trs "Metabase Enterprise Edition extensions are NOT PRESENT.")))) |
--------------------------------------------------- Lifecycle ---------------------------------------------------- | |
Print the setup url during instance initialization. | (defn- print-setup-url
[]
(let [hostname (or (config/config-str :mb-jetty-host) "localhost")
port (config/config-int :mb-jetty-port)
site-url (or (public-settings/site-url)
(str "http://"
hostname
(when-not (= 80 port) (str ":" port))))
setup-url (str site-url "/setup/")]
(log/info (u/format-color 'green
(str (deferred-trs "Please use the following URL to setup your Metabase installation:")
"\n\n"
setup-url
"\n\n"))))) |
Create and set a new setup token and log it. | (defn- create-setup-token-and-log-setup-url! [] (setup/create-token!) ; we need this here to create the initial token (print-setup-url)) |
General application shutdown function which should be called once at application shutdown. | (defn- destroy! [] (log/info (trs "Metabase Shutting Down ...")) ;; TODO - it would really be much nicer if we implemented a basic notification system so these things could listen ;; to a Shutdown hook of some sort instead of having here (task/stop-scheduler!) (server/stop-web-server!) (prometheus/shutdown!) (log/info (trs "Metabase Shutdown COMPLETE"))) |
OSS implementation of | (defenterprise ensure-audit-db-installed! metabase-enterprise.audit-db [] ::noop) |
General application initialization function which should be run once at application startup. | (defn- init!*
[]
(log/info (trs "Starting Metabase version {0} ..." config/mb-version-string))
(log/info (trs "System info:\n {0}" (u/pprint-to-str (troubleshooting/system-info))))
(init-status/set-progress! 0.1)
;; First of all, lets register a shutdown hook that will tidy things up for us on app exit
(.addShutdownHook (Runtime/getRuntime) (Thread. ^Runnable destroy!))
(init-status/set-progress! 0.2)
;; load any plugins as needed
(plugins/load-plugins!)
(init-status/set-progress! 0.3)
(settings/validate-settings-formatting!)
;; startup database. validates connection & runs any necessary migrations
(log/info (trs "Setting up and migrating Metabase DB. Please sit tight, this may take a minute..."))
(mdb/setup-db!)
(init-status/set-progress! 0.5)
;; Set up Prometheus
(when (prometheus/prometheus-server-port)
(log/info (trs "Setting up prometheus metrics"))
(prometheus/setup!)
(init-status/set-progress! 0.6))
;; run a very quick check to see if we are doing a first time installation
;; the test we are using is if there is at least 1 User in the database
(let [new-install? (not (setup/has-user-setup))]
;; initialize Metabase from an `config.yml` file if present (Enterprise Edition™ only)
(config-from-file/init-from-file-if-code-available!)
(init-status/set-progress! 0.7)
(when new-install?
(log/info (trs "Looks like this is a new installation ... preparing setup wizard"))
;; create setup token
(create-setup-token-and-log-setup-url!)
;; publish install event
(events/publish-event! :event/install {}))
(init-status/set-progress! 0.8)
;; deal with our sample database as needed
(if new-install?
;; add the sample database DB for fresh installs
(sample-data/add-sample-database!)
;; otherwise update if appropriate
(sample-data/update-sample-database-if-needed!))
(init-status/set-progress! 0.9))
(ensure-audit-db-installed!)
(init-status/set-progress! 0.95)
;; start scheduler at end of init!
(task/start-scheduler!)
(init-status/set-complete!)
(let [start-time (.getStartTime (ManagementFactory/getRuntimeMXBean))
duration (- (System/currentTimeMillis) start-time)]
(log/info (trs "Metabase Initialization COMPLETE in {0}" (u/format-milliseconds duration))))) |
General application initialization function which should be run once at application startup. Calls `[[init!*]] and records the duration of startup. | (defn init!
[]
(let [start-time (t/zoned-date-time)]
(init!*)
(public-settings/startup-time-millis!
(.toMillis (t/duration start-time (t/zoned-date-time)))))) |
-------------------------------------------------- Normal Start -------------------------------------------------- | |
(defn- start-normally []
(log/info (trs "Starting Metabase in STANDALONE mode"))
(try
;; launch embedded webserver async
(server/start-web-server! handler/app)
;; run our initialization process
(init!)
;; Ok, now block forever while Jetty does its thing
(when (config/config-bool :mb-jetty-join)
(.join (server/instance)))
(catch Throwable e
(log/error e (trs "Metabase Initialization FAILED"))
(System/exit 1)))) | |
(defn- run-cmd [cmd args] (classloader/require 'metabase.cmd) ((resolve 'metabase.cmd/run-cmd) cmd args)) | |
-------------------------------------------------- Tracing ------------------------------------------------------- | |
(defn- maybe-enable-tracing
[]
(let [mb-trace-str (config/config-str :mb-ns-trace)]
(when (not-empty mb-trace-str)
(log/warn (trs "WARNING: You have enabled namespace tracing, which could log sensitive information like db passwords."))
(doseq [namespace (map symbol (str/split mb-trace-str #",\s*"))]
(try (require namespace)
(catch Throwable _
(throw (ex-info "A namespace you specified with MB_NS_TRACE could not be required" {:namespace namespace}))))
(trace/trace-ns namespace))))) | |
------------------------------------------------ App Entry Point ------------------------------------------------- | |
Launch Metabase in standalone mode. (Main application entrypoint is [[metabase.bootstrap/-main]].) | (defn entrypoint
[& [cmd & args]]
(maybe-enable-tracing)
(if cmd
(run-cmd cmd args) ; run a command like `java -jar metabase.jar migrate release-locks` or `clojure -M:run migrate release-locks`
(start-normally))) ; with no command line args just start Metabase normally |
(ns metabase.core.config-from-file (:require [metabase.plugins.classloader :as classloader] [metabase.util.log :as log])) | |
Shim for running the config-from-file code, used by [[metabase.core]]. The config-from-file code only ships in the Enterprise Edition™ JAR, so this checks whether the namespace exists, and if it does, invokes [[metabase-enterprise.advanced-config.file/initialize!]]; otherwise, this no-ops. | (defn init-from-file-if-code-available!
[]
(when (try
(classloader/require 'metabase-enterprise.advanced-config.file)
:ok
(catch Throwable _
(log/debug "metabase-enterprise.advanced-config.file not available; cannot initialize from file.")
nil))
((resolve 'metabase-enterprise.advanced-config.file/initialize!)))) |
Code related to tracking the progress of metabase initialization.
This is kept in a separate, tiny namespace so it can be loaded right away when the application launches
(and so we don't need to wait for | (ns metabase.core.initialization-status) |
(defonce ^:private progress-atom (atom 0)) | |
Is Metabase initialized and ready to be served? | (defn complete? [] (= @progress-atom 1.0)) |
Get the current progress of Metabase initialization. | (defn progress [] @progress-atom) |
Update the Metabase initialization progress to a new value, a floating-point value between | (defn set-progress!
[^Float new-progress]
{:pre [(float? new-progress) (<= 0.0 new-progress 1.0)]}
(reset! progress-atom new-progress)) |
Complete the Metabase initialization by setting its progress to 100%. | (defn set-complete! [] (set-progress! 1.0)) |
High-level functions for setting up the Metabase application database. Additional functions can be found in sub-namespaces:
| (ns metabase.db (:require [clojure.core.async.impl.dispatch :as a.impl.dispatch] [metabase.config :as config] [metabase.db.connection :as mdb.connection] [metabase.db.setup :as mdb.setup] [methodical.core :as methodical] [potemkin :as p] [toucan2.pipeline :as t2.pipeline])) |
TODO - determine if we actually need to import any of these These are mostly here as a convenience to avoid having to rework a bunch of existing code. It's better to use these functions directly where applicable. | (p/import-vars [mdb.connection db-type quoting-style]) |
True if the Metabase DB is setup and ready. TODO -- consider whether we can just do this automatically when | (defn db-is-set-up? [] (= @(:status mdb.connection/*application-db*) ::setup-finished)) |
Do general preparation of database by validating that we can connect. Caller can specify if we should run any pending database migrations. If DB is already set up, this function will no-op. Thread-safe. | (defn setup-db!
[]
(when-not (db-is-set-up?)
;; It doesn't really matter too much what we lock on, as long as the lock is per-application-DB e.g. so we can run
;; setup for DIFFERENT application DBs at the same time, but CAN NOT run it for the SAME application DB. We can just
;; use the application DB object itself to lock on since that will be a different object for different application
;; DBs.
(locking mdb.connection/*application-db*
(when-not (db-is-set-up?)
(let [db-type (mdb.connection/db-type)
data-source (mdb.connection/data-source)
auto-migrate? (config/config-bool :mb-db-automigrate)]
(mdb.setup/setup-db! db-type data-source auto-migrate?))
(reset! (:status mdb.connection/*application-db*) ::setup-finished))))
:done) |
(methodical/defmethod t2.pipeline/transduce-query :before :default
"Make sure application database calls are not done inside core.async dispatch pool threads. This is done relatively
early in the pipeline so the stacktrace when this fails isn't super enormous."
[_rf _query-type₁ _model₂ _parsed-args resolved-query]
(when (a.impl.dispatch/in-dispatch-thread?)
(throw (ex-info "Application database calls are not allowed inside core.async dispatch pool threads."
{})))
resolved-query) | |
Functions for getting the application database connection type and JDBC spec, or temporarily overriding them.
TODO - consider renaming this namespace | (ns metabase.db.connection (:require [metabase.db.connection-pool-setup :as connection-pool-setup] [metabase.db.env :as mdb.env] [methodical.core :as methodical] [potemkin :as p] [toucan2.connection :as t2.conn] [toucan2.jdbc.connection :as t2.jdbc.conn]) (:import (java.util.concurrent.locks ReentrantReadWriteLock))) |
(set! *warn-on-reflection* true) | |
Counter for [[unique-identifier]] -- this is a simple counter rather that [[java.util.UUID/randomUUID]] so we don't waste precious entropy on launch generating something that doesn't need to be random (it just needs to be unique) | (defonce application-db-counter (atom 0)) |
(p/defrecord+ ApplicationDB [^clojure.lang.Keyword db-type
^javax.sql.DataSource data-source
;; used by [[metabase.db/setup-db!]] and [[metabase.db/db-is-set-up?]] to record whether
;; the usual setup steps have been performed (i.e., running Liquibase and Clojure-land data
;; migrations).
^clojure.lang.Atom status
;; A unique identifier generated for this specific application DB. Use this as a
;; memoization/cache key. See [[unique-identifier]] for more information.
id
;; Reentrant read-write lock for GETTING new connections. Lock doesn't track whether any
;; existing connections are open! Holding the write lock will however prevent any NEW
;; connections from being acquired.
;;
;; This is a reentrant read-write lock, which means any number of read locks are allowed at
;; the same time, but the write lock is exclusive. So if you want to prevent anyone from
;; getting new connections, lock the write lock.
;;
;; The main purpose of this is to power [[metabase.api.testing]] which allows you to reset
;; the application DB with data from a SQL dump -- during the restore process it is
;; important that we do not allow anyone to access the DB.
^ReentrantReadWriteLock lock]
javax.sql.DataSource
(getConnection [_]
(try
(.. lock readLock lock)
(.getConnection data-source)
(finally
(.. lock readLock unlock))))
(getConnection [_ user password]
(try
(.. lock readLock lock)
(.getConnection data-source user password)
(finally
(.. lock readLock unlock))))) | |
(alter-meta! #'->ApplicationDB assoc :private true) (alter-meta! #'map->ApplicationDB assoc :private true) | |
(def ^:private initial-db-status nil) | |
Create a new Metabase application database (type and [[javax.sql.DataSource]]). For use in combination with [[application-db]]: (binding [mdb.connection/application-db (mdb.connection/application-db :h2 my-data-source)] ...) Options:
| (defn application-db
^ApplicationDB [db-type data-source & {:keys [create-pool?], :or {create-pool? false}}]
;; this doesn't use [[schema.core/defn]] because [[schema.core/defn]] doesn't like optional keyword args
{:pre [(#{:h2 :mysql :postgres} db-type)
(instance? javax.sql.DataSource data-source)]}
(map->ApplicationDB
{:db-type db-type
:data-source (if create-pool?
(connection-pool-setup/connection-pool-data-source db-type data-source)
data-source)
:status (atom initial-db-status)
;; for memoization purposes. See [[unique-identifier]] for more information.
:id (swap! application-db-counter inc)
:lock (ReentrantReadWriteLock.)})) |
Type info and [[javax.sql.DataSource]] for the current Metabase application database. Create a new instance with [[application-db]]. | (def ^:dynamic ^ApplicationDB *application-db* (application-db mdb.env/db-type mdb.env/data-source :create-pool? true)) |
Keyword type name of the application DB. Matches corresponding db-type name e.g. | (defn db-type [] (.db-type *application-db*)) |
HoneySQL quoting style to use for application DBs of the given type. Note for H2 application DBs we automatically uppercase all identifiers (since this is H2's default behavior) whereas in the SQL QP we stick with the case we got when we synced the DB. | (defn quoting-style
[db-type]
(case db-type
:postgres :ansi
:h2 :h2
:mysql :mysql)) |
Get a data source for the application DB, derived from environment variables. Usually this should be a pooled data source (i.e. a c3p0 pool) -- but in test situations it might not be. TODO -- you can just use [[application-db]] directly, we can probably get rid of this and use that directly instead | (defn data-source ^javax.sql.DataSource [] (.data-source *application-db*)) |
Unique identifier for the Metabase application DB. This value will stay the same as long as the application DB stays the same; if the application DB is dynamically rebound, this will return a new value. For normal memoization you can use [[memoize-for-application-db]]; you should only need to use this directly for TTL memoization with [[clojure.core.memoize]] or other special cases. See [[metabase.driver.util/database->driver*]] for an example of using this for TTL memoization. I didn't call this | (defn unique-identifier [] (.id *application-db*)) |
Like [[clojure.core/memoize]], but only memoizes for the current application database; memoized values will be
ignored if the app DB is dynamically rebound. For TTL memoization with [[clojure.core.memoize]], set
| (defn memoize-for-application-db
[f]
(let [f* (memoize (fn [_application-db-id & args]
(apply f args)))]
(fn [& args]
(apply f* (unique-identifier) args)))) |
(methodical/defmethod t2.conn/do-with-connection :default [_connectable f] (t2.conn/do-with-connection *application-db* f)) | |
(def ^:private ^:dynamic *transaction-depth* 0) | |
(defn- do-transaction [^java.sql.Connection connection f]
(letfn [(thunk []
(let [savepoint (.setSavepoint connection)]
(try
(let [result (f connection)]
(when (= *transaction-depth* 1)
;; top-level transaction, commit
(.commit connection))
result)
(catch Throwable e
(.rollback connection savepoint)
(throw e)))))]
;; optimization: don't set and unset autocommit if it's already false
(if (.getAutoCommit connection)
(try
(.setAutoCommit connection false)
(thunk)
(finally
(.setAutoCommit connection true)))
(thunk)))) | |
(comment ;; in toucan2.jdbc.connection, there is a 'defmethod' for t2.conn/do-with-transaction java.sql.Connection ;; since we don't want our implementation to be overwritten, we need to require it here first before defininng ours t2.jdbc.conn/keepme) | |
(methodical/defmethod t2.conn/do-with-transaction java.sql.Connection
"Support nested transactions without introducing a lock like `next.jdbc` does, as that can cause deadlocks -- see
https://github.com/seancorfield/next-jdbc/issues/244. Use `Savepoint`s because MySQL only supports nested
transactions when done this way.
See also https://metaboat.slack.com/archives/CKZEMT1MJ/p1694103570500929
Note that these \"nested transactions\" are not the real thing (e.g., as in Oracle):
- there is only one commit, meaning that every transaction in a tree of transactions can see the changes
other transactions have made,
- in the presence of unsynchronized concurrent threads running nested transactions, the effects of rollback
are not well defined - a rollback will undo all work done by other transactions in the same tree that
started later."
[^java.sql.Connection connection {:keys [nested-transaction-rule] :or {nested-transaction-rule :allow} :as options} f]
(assert (#{:allow :ignore :prohibit} nested-transaction-rule))
(cond
(and (pos? *transaction-depth*)
(= nested-transaction-rule :ignore))
(f connection)
(and (pos? *transaction-depth*)
(= nested-transaction-rule :prohibit))
(throw (ex-info "Attempted to create nested transaction with :nested-transaction-rule set to :prohibit"
{:options options}))
:else
(binding [*transaction-depth* (inc *transaction-depth*)]
(do-transaction connection f)))) | |
Code for creating the connection pool for the application DB and setting it as the default Toucan connection. | (ns metabase.db.connection-pool-setup (:require [java-time.api :as t] [metabase.config :as config] [metabase.connection-pool :as connection-pool] [schema.core :as s]) (:import (com.mchange.v2.c3p0 ConnectionCustomizer PoolBackedDataSource))) |
(set! *warn-on-reflection* true) | |
(def ^:private latest-activity (atom nil)) | |
(def ^:private ^java.time.Duration recent-window-duration (t/seconds 15)) | |
(defn- recent-activity?*
[activity duration]
(when activity
(t/after? activity (t/minus (t/offset-date-time) duration)))) | |
Returns true if there has been recent activity. Define recent activity as an application db connection checked in, checked out, or acquired within [[recent-window-duration]]. Check-in means a query succeeded and the db connection is no longer needed. | (defn recent-activity? [] (recent-activity?* @latest-activity recent-window-duration)) |
(defrecord DbActivityTracker []
ConnectionCustomizer
(onAcquire [_ _connection _identity-token]
(reset! latest-activity (t/offset-date-time)))
(onCheckIn [_ _connection _identity-token]
(reset! latest-activity (t/offset-date-time)))
(onCheckOut [_ _connection _identity-token]
(reset! latest-activity (t/offset-date-time)))
(onDestroy [_ _connection _identity-token])) | |
c3p0 allows for hooking into lifecycles with its interface ConnectionCustomizer. https://www.mchange.com/projects/c3p0/apidocs/com/mchange/v2/c3p0/ConnectionCustomizer.html. But Clojure defined code is in memory in a dynamic class loader not available to c3p0's use of Class/forName. Luckily it looks up the instances in a cache which I pre-seed with out impl here. Issue for better access here: https://github.com/swaldman/c3p0/issues/166 | (defn- register-customizer!
[^Class klass]
(let [field (doto (.getDeclaredField com.mchange.v2.c3p0.C3P0Registry "classNamesToConnectionCustomizers")
(.setAccessible true))]
(.put ^java.util.HashMap (.get field com.mchange.v2.c3p0.C3P0Registry)
(.getName klass) (.newInstance klass)))) |
(register-customizer! DbActivityTracker) | |
Options for c3p0 connection pool for the application DB. These are set in code instead of a properties file because we use separate options for data warehouse DBs. See https://www.mchange.com/projects/c3p0/#configuringconnectiontesting for an overview of the options used below (jump to the 'Simple advice on Connection testing' section.) | (def ^:private application-db-connection-pool-props
(merge
{"idleConnectionTestPeriod" 60
"connectionCustomizerClassName" (.getName DbActivityTracker)}
;; only merge in `max-pool-size` if it's actually set, this way it doesn't override any things that may have been
;; set in `c3p0.properties`
(when-let [max-pool-size (config/config-int :mb-application-db-max-connection-pool-size)]
{"maxPoolSize" max-pool-size}))) |
(s/defn connection-pool-data-source :- PoolBackedDataSource
"Create a connection pool [[javax.sql.DataSource]] from an unpooled [[javax.sql.DataSource]] `data-source`. If
`data-source` is already pooled, this will return `data-source` as-is."
[db-type :- s/Keyword
data-source :- javax.sql.DataSource]
(if (instance? PoolBackedDataSource data-source)
data-source
(let [ds-name (format "metabase-%s-app-db" (name db-type))
pool-props (assoc application-db-connection-pool-props "dataSourceName" ds-name)]
(com.mchange.v2.c3p0.DataSources/pooledDataSource
data-source
(connection-pool/map->properties pool-props))))) | |
Custom liquibase migrations, so we can manipulate data with Clojure. We prefer to use SQL migrations in most cases because they are likely to be more performant and stable. However, there are some cases where we need to do something that is not possible or very difficult with SQL, such as JSON manipulation. Migrations demand a higher level of reliability than normal code, so be careful about what these migrations depend on. If the code the migration depends on changes, the migration could corrupt app dbs and be very difficult to recover from. If you need to use code from elsewhere, consider copying it into this namespace to minimize risk of the code changing behaviour. | (ns metabase.db.custom-migrations (:require [cheshire.core :as json] [clojure.core.match :refer [match]] [clojure.java.io :as io] [clojure.set :as set] [clojure.walk :as walk] [clojurewerkz.quartzite.jobs :as jobs] [clojurewerkz.quartzite.scheduler :as qs] [clojurewerkz.quartzite.triggers :as triggers] [medley.core :as m] [metabase.db.connection :as mdb.connection] [metabase.models.interface :as mi] [metabase.plugins.classloader :as classloader] [metabase.util.honey-sql-2 :as h2x] [metabase.util.log :as log] [toucan2.core :as t2] [toucan2.execute :as t2.execute]) (:import (java.util Locale) (liquibase Scope) (liquibase.change Change) (liquibase.change.custom CustomTaskChange CustomTaskRollback) (liquibase.exception ValidationErrors) (liquibase.util BooleanUtil))) |
(set! *warn-on-reflection* true) | |
Check if the change is supposed to be executed. This is a work around. The rollback method is called twice: once for generating MDC data and once for actually making the change. The same problem has been fixed for forward changes in Liquibase but for rollback it has not. | (defn should-execute-change? [] (BooleanUtil/isTrue (.get (Scope/getCurrentScope) Change/SHOULD_EXECUTE true))) |
Define a reversible custom migration. Both the forward and reverse migrations are defined using the same structure, similar to the bodies of multi-arity Clojure functions. Example: ```clj (define-reversible-migration ExampleMigrationName (migration-body) (reverse-migration-body))) ``` | (defmacro define-reversible-migration
[name migration-body reverse-migration-body]
`(defrecord ~name []
CustomTaskChange
(execute [_# database#]
(t2/with-transaction [_conn#]
~migration-body))
(getConfirmationMessage [_#]
(str "Custom migration: " ~name))
(setUp [_#])
(validate [_# _database#]
(ValidationErrors.))
(setFileOpener [_# _resourceAccessor#])
CustomTaskRollback
(rollback [_# database#]
(t2/with-transaction [_conn#]
(when (should-execute-change?)
~reverse-migration-body))))) |
No-op logging rollback function | (defn no-op [n] (log/info "No rollback for: " n)) |
Define a custom migration without a reverse migration. | (defmacro define-migration [name & migration-body] `(define-reversible-migration ~name (do ~@migration-body) (no-op ~(str name)))) |
+----------------------------------------------------------------------------------------------------------------+ | HELPERS | +----------------------------------------------------------------------------------------------------------------+ | |
metabase.util/upper-case-en | (defn- upper-case-en [s] (.toUpperCase (str s) (Locale/US))) |
+----------------------------------------------------------------------------------------------------------------+ | MIGRATIONS | +----------------------------------------------------------------------------------------------------------------+ | |
(def ^:private base-path-regex #"^(/db/\d+(?:/schema/(?:(?:[^\\/])|(?:\\/)|(?:\\\\))*(?:/table/\d+?)?)?/)((native/)|(query/(segmented/)?))?$") | |
Converts v1 data permission paths into v2 data and query permissions paths. This is similar to | (defn- ->v2-paths
[v1-path]
(if-let [base-path (second (re-find base-path-regex v1-path))]
;; For (almost) all v1 data paths, we simply extract the base path (e.g. "/db/1/schema/PUBLIC/table/1/")
;; and construct new v2 paths by adding prefixes to the base path.
[(str "/data" base-path) (str "/query" base-path)]
;; For the specific v1 path that grants full data access but no native query access, we add a
;; /schema/ suffix to the corresponding v2 query permission path.
(when-let [db-id (second (re-find #"^/db/(\d+)/schema/$" v1-path))]
[(str "/data/db/" db-id "/") (str "/query/db/" db-id "/schema/")]))) |
(define-reversible-migration SplitDataPermissions
(let [current-perms-set (t2/select-fn-set
(juxt :object :group_id)
:permissions
{:where [:or
[:like :object (h2x/literal "/db/%")]
[:like :object (h2x/literal "/data/db/%")]
[:like :object (h2x/literal "/query/db/%")]]})
v2-perms-set (into #{} (mapcat
(fn [[v1-path group-id]]
(for [v2-path (->v2-paths v1-path)]
[v2-path group-id]))
current-perms-set))
new-v2-perms (into [] (set/difference v2-perms-set current-perms-set))]
(when (seq new-v2-perms)
(t2.execute/query-one {:insert-into :permissions
:columns [:object :group_id]
:values new-v2-perms})))
(t2.execute/query-one {:delete-from :permissions
:where [:or [:like :object (h2x/literal "/data/db/%")]
[:like :object (h2x/literal "/query/db/%")]]})) | |
+----------------------------------------------------------------------------------------------------------------+ | Quartz Scheduler Helpers | +----------------------------------------------------------------------------------------------------------------+ | |
This section of code's purpose is to avoid the migration depending on the [[metabase.task]] namespace, which is likely to change, and might not have as tight test coverage as needed for custom migrations. | |
(defn- load-class ^Class [^String class-name] (Class/forName class-name true (classloader/the-classloader))) | |
(defrecord ^:private ClassLoadHelper []
org.quartz.spi.ClassLoadHelper
(initialize [_])
(getClassLoader [_]
(classloader/the-classloader))
(loadClass [_ class-name]
(load-class class-name))
(loadClass [_ class-name _]
(load-class class-name))) | |
(when-not *compile-files* (System/setProperty "org.quartz.scheduler.classLoadHelper.class" (.getName ClassLoadHelper))) | |
Set the appropriate system properties needed so Quartz can connect to the JDBC backend. (Since we don't know our DB
connection properties ahead of time, we'll need to set these at runtime rather than Setting them in the
| (defn- set-jdbc-backend-properties!
[]
(when (= (mdb.connection/db-type) :postgres)
(System/setProperty "org.quartz.jobStore.driverDelegateClass" "org.quartz.impl.jdbcjobstore.PostgreSQLDelegate"))) |
+----------------------------------------------------------------------------------------------------------------+ | |
(define-migration DeleteAbandonmentEmailTask
(classloader/the-classloader)
(set-jdbc-backend-properties!)
(let [scheduler (qs/initialize)]
(qs/start scheduler)
(qs/delete-trigger scheduler (triggers/key "metabase.task.abandonment-emails.trigger"))
(qs/delete-job scheduler (jobs/key "metabase.task.abandonment-emails.job"))
(qs/shutdown scheduler))) | |
(define-migration FillJSONUnfoldingDefault
(let [db-ids-to-not-update (->> (t2/query {:select [:id :details]
:from [:metabase_database]})
;; if json-unfolding is nil it's treated as if it were true
;; so we need to remove databases that have it set to false
(filter (fn [{:keys [details]}]
(when details
(false? (:json-unfolding (json/parse-string details true))))))
(map :id))
field-ids-to-update (->> (t2/query {:select [:f.id]
:from [[:metabase_field :f]]
:join [[:metabase_table :t] [:= :t.id :f.table_id]]
:where (if (seq db-ids-to-not-update)
[:and
[:not-in :t.db_id db-ids-to-not-update]
[:= :f.base_type "type/JSON"]]
[:= :f.base_type "type/JSON"])})
(map :id))]
(when (seq field-ids-to-update)
(t2/query-one {:update :metabase_field
:set {:json_unfolding true}
:where [:in :metabase_field.id field-ids-to-update]})))) | |
(defn- update-legacy-field-refs-in-viz-settings [viz-settings]
(let [old-to-new (fn [old]
(match old
["ref" ref] ["ref" (match ref
["field-id" x] ["field" x nil]
["field-literal" x y] ["field" x {"base-type" y}]
["fk->" x y] (let [x (match x
[_x0 x1] x1
x x)
y (match y
[_y0 y1] y1
y y)]
["field" y {:source-field x}])
ref ref)]
k k))]
(m/update-existing viz-settings "column_settings" update-keys
(fn [k]
(-> k
json/parse-string
vec
old-to-new
json/generate-string))))) | |
(define-migration MigrateLegacyColumnSettingsFieldRefs
(let [update! (fn [{:keys [id visualization_settings]}]
(t2/query-one {:update :report_card
:set {:visualization_settings visualization_settings}
:where [:= :id id]}))]
(run! update! (eduction (keep (fn [{:keys [id visualization_settings]}]
(let [parsed (json/parse-string visualization_settings)
updated (update-legacy-field-refs-in-viz-settings parsed)]
(when (not= parsed updated)
{:id id
:visualization_settings (json/generate-string updated)}))))
(t2/reducible-query {:select [:id :visualization_settings]
:from [:report_card]
:where [:or
;; these match legacy field refs in column_settings
[:like :visualization_settings "%ref\\\\\",[\\\\\"field-id%"]
[:like :visualization_settings "%ref\\\\\",[\\\\\"field-literal%"]
[:like :visualization_settings "%ref\\\\\",[\\\\\"fk->%"]
;; MySQL with NO_BACKSLASH_ESCAPES disabled:
[:like :visualization_settings "%ref\\\\\\\",[\\\\\\\"field-id%"]
[:like :visualization_settings "%ref\\\\\\\",[\\\\\\\"field-literal%"]
[:like :visualization_settings "%ref\\\\\\\",[\\\\\\\"fk->%"]]}))))) | |
(defn- update-legacy-field-refs-in-result-metadata [result-metadata]
(let [old-to-new (fn [ref]
(match ref
["field-id" x] ["field" x nil]
["field-literal" x y] ["field" x {"base-type" y}]
["fk->" x y] (let [x (match x
[_x0 x1] x1
x x)
y (match y
[_y0 y1] y1
y y)]
["field" y {:source-field x}])
_ ref))]
(->> result-metadata
json/parse-string
(map #(m/update-existing % "field_ref" old-to-new))
json/generate-string))) | |
(define-migration MigrateLegacyResultMetadataFieldRefs
(let [update! (fn [{:keys [id result_metadata]}]
(t2/query-one {:update :report_card
:set {:result_metadata result_metadata}
:where [:= :id id]}))]
(run! update! (eduction (keep (fn [{:keys [id result_metadata]}]
(let [updated (update-legacy-field-refs-in-result-metadata result_metadata)]
(when (not= result_metadata updated)
{:id id
:result_metadata updated}))))
(t2/reducible-query {:select [:id :result_metadata]
:from [:report_card]
:where [:or
[:like :result_metadata "%field-id%"]
[:like :result_metadata "%field-literal%"]
[:like :result_metadata "%fk->%"]]}))))) | |
Removes options from the | (defn- remove-opts
[field_ref & opts-to-remove]
(match field_ref
["field" id opts] ["field" id (not-empty (apply dissoc opts opts-to-remove))]
_ field_ref)) |
(defn- remove-join-alias-from-column-settings-field-refs [visualization_settings]
(update visualization_settings "column_settings"
(fn [column_settings]
(into {}
(map (fn [[k v]]
(match (vec (json/parse-string k))
["ref" ["field" id opts]]
[(json/generate-string ["ref" (remove-opts ["field" id opts] "join-alias")]) v]
_ [k v]))
column_settings))))) | |
(defn- add-join-alias-to-column-settings-refs [{:keys [visualization_settings result_metadata]}]
(let [result_metadata (json/parse-string result_metadata)
visualization_settings (json/parse-string visualization_settings)
column-key->metadata (group-by #(-> (get % "field_ref")
;; like the FE's `getColumnKey` function, remove "join-alias",
;; "temporal-unit" and "binning" options from the field_ref
(remove-opts "join-alias" "temporal-unit" "binning"))
result_metadata)]
(json/generate-string
(update visualization_settings "column_settings"
(fn [column_settings]
(into {}
(mapcat (fn [[k v]]
(match (vec (json/parse-string k))
["ref" ["field" id opts]]
(for [column-metadata (column-key->metadata ["field" id opts])
;; remove "temporal-unit" and "binning" options from the matching field refs,
;; but not "join-alias" as before.
:let [field-ref (-> (get column-metadata "field_ref")
(remove-opts "temporal-unit" "binning"))]]
[(json/generate-string ["ref" field-ref]) v])
_ [[k v]]))
column_settings))))))) | |
(define-reversible-migration AddJoinAliasToVisualizationSettingsFieldRefs
(let [update-one! (fn [{:keys [id visualization_settings] :as card}]
(let [updated (add-join-alias-to-column-settings-refs card)]
(when (not= visualization_settings updated)
(t2/query-one {:update :report_card
:set {:visualization_settings updated}
:where [:= :id id]}))))]
(run! update-one! (t2/reducible-query {:select [:id :visualization_settings :result_metadata]
:from [:report_card]
:where [:and
[:or
[:= :query_type nil]
[:= :query_type "query"]]
[:or
[:like :visualization_settings "%ref\\\\\",[\\\\\"field%"]
; MySQL with NO_BACKSLASH_ESCAPES disabled
[:like :visualization_settings "%ref\\\\\\\",[\\\\\\\"field%"]]
[:like :result_metadata "%join-alias%"]]})))
(let [update! (fn [{:keys [id visualization_settings]}]
(let [updated (-> visualization_settings
json/parse-string
remove-join-alias-from-column-settings-field-refs
json/generate-string)]
(when (not= visualization_settings updated)
(t2/query-one {:update :report_card
:set {:visualization_settings updated}
:where [:= :id id]}))))]
(run! update! (t2/reducible-query {:select [:id :visualization_settings]
:from [:report_card]
:where [:and
[:or
[:= :query_type nil]
[:= :query_type "query"]]
[:or
[:like :visualization_settings "%ref\\\\\",[\\\\\"field%"]
[:like :visualization_settings "%ref\\\\\\\",[\\\\\\\"field%"]]
[:like :visualization_settings "%join-alias%"]]})))) | |
(defn- update-card-row-on-downgrade-for-dashboard-tab
[dashboard-id]
(let [tab+cards (->> (t2/query {:select [:report_dashboardcard.* [:dashboard_tab.position :tab_position]]
:from [:report_dashboardcard]
:where [:= :report_dashboardcard.dashboard_id dashboard-id]
:left-join [:dashboard_tab [:= :dashboard_tab.id :report_dashboardcard.dashboard_tab_id]]})
(group-by :tab_position)
;; sort by tab position
(sort-by first))
cards->max-height (fn [cards] (apply max (map #(+ (:row %) (:size_y %)) cards)))]
(loop [position+cards tab+cards
next-tab-row 0]
(when-let [[tab-pos cards] (first position+cards)]
(if (zero? tab-pos)
(recur (rest position+cards) (long (cards->max-height cards)))
(do
(t2/query {:update :report_dashboardcard
:set {:row [:+ :row next-tab-row]}
:where [:= :dashboard_tab_id (:dashboard_tab_id (first cards))]})
(recur (rest position+cards) (long (+ next-tab-row (cards->max-height cards)))))))))) | |
(define-reversible-migration DowngradeDashboardTab
(log/info "No forward migration for DowngradeDashboardTab")
(run! update-card-row-on-downgrade-for-dashboard-tab
(eduction (map :dashboard_id) (t2/reducible-query {:select-distinct [:dashboard_id]
:from [:dashboard_tab]})))) | |
Perform the best effort to destructure card sizes in revision. The card in revision contains legacy field name and maybe even lacking fields. | (defn- destructure-revision-card-sizes
[card]
{:size_x (or (get card :size_x)
(get card :sizeX)
4)
:size_y (or (get card :size_y)
(get card :sizeY)
4)
:row (or (get card :row) 0)
:col (or (get card :col) 0)}) |
Mirror of the forward algorithm we have in sql. | (defn- migrate-dashboard-grid-from-18-to-24
[card]
(let [{:keys [row col size_x size_y]} (destructure-revision-card-sizes card)]
;; new_size_x = size_x + ((col + size_x + 1) // 3) - ((col + 1) // 3)
;; new_col = col + ((col + 1) // 3)
;; need to wrap it a try catch in case anything weird could go wrong, for example
;; sizes are string
(try
(merge
(dissoc card :sizeX :sizeY) ;; remove those legacy keys if exists
{:size_x (- (+ size_x
(quot (+ col size_x 1) 3))
(quot (+ col 1) 3))
:col (+ col (quot (+ col 1) 3))
:size_y size_y
:row row})
(catch Throwable _
card)))) |
Mirror of the rollback algorithm we have in sql. | (defn- migrate-dashboard-grid-from-24-to-18
[card]
(let [{:keys [row col size_x size_y]} (destructure-revision-card-sizes card)]
;; new_size_x = size_x - ((size_x + col + 1) // 4 - (col + 1) // 4)
;; new_col = col - (col + 1) // 4
(try
(merge
card
{:size_x (if (= size_x 1)
1
(- size_x
(-
(quot (+ size_x col 1) 4)
(quot (+ col 1) 4))))
:col (- col (quot (+ col 1) 4))
:size_y size_y
:row row})
(catch Throwable _
card)))) |
(define-reversible-migration RevisionDashboardMigrateGridFrom18To24
(let [migrate! (fn [revision]
(let [object (json/parse-string (:object revision) keyword)]
(when (seq (:cards object))
(t2/query {:update :revision
:set {:object (json/generate-string (update object :cards #(map migrate-dashboard-grid-from-18-to-24 %)))}
:where [:= :id (:id revision)]}))))]
(run! migrate! (t2/reducible-query {:select [:*]
:from [:revision]
:where [:= :model "Dashboard"]})))
(let [roll-back! (fn [revision]
(let [object (json/parse-string (:object revision) keyword)]
(when (seq (:cards object))
(t2/query {:update :revision
:set {:object (json/generate-string (update object :cards #(map migrate-dashboard-grid-from-24-to-18 %)))}
:where [:= :id (:id revision)]}))))]
(run! roll-back! (t2/reducible-query {:select [:*]
:from [:revision]
:where [:= :model "Dashboard"]})))) | |
(define-migration RevisionMigrateLegacyColumnSettingsFieldRefs
(let [update-one! (fn [{:keys [id object]}]
(let [object (json/parse-string object)
updated (update object "visualization_settings" update-legacy-field-refs-in-viz-settings)]
(when (not= updated object)
(t2/query-one {:update :revision
:set {:object (json/generate-string updated)}
:where [:= :id id]}))))]
(run! update-one! (t2/reducible-query {:select [:id :object]
:from [:revision]
:where [:and
[:= :model "Card"]
[:or
;; these match legacy field refs in column_settings
[:like :object "%ref\\\\\",[\\\\\"field-id%"]
[:like :object "%ref\\\\\",[\\\\\"field-literal%"]
[:like :object "%ref\\\\\",[\\\\\"fk->%"]
;; MySQL with NO_BACKSLASH_ESCAPES disabled:
[:like :object "%ref\\\\\\\",[\\\\\\\"field-id%"]
[:like :object "%ref\\\\\\\",[\\\\\\\"field-literal%"]
[:like :object "%ref\\\\\\\",[\\\\\\\"fk->%"]]]})))) | |
(define-reversible-migration RevisionAddJoinAliasToColumnSettingsFieldRefs
;; This migration is essentially the same as `AddJoinAliasToColumnSettingsFieldRefs`, but for card revisions.
;; We can't use the same migration because cards in the revision table don't always have `result_metadata`.
;; So instead, we use the join aliases from card's `dataset_query` to create field refs in visualization_settings.
;; There will inevitably be extra entries in visualization_settings.column_settings that don't match field refs in result_metadata, but that's ok.
(let [add-join-aliases
(fn [card]
(let [join-aliases (->> (get-in card ["dataset_query" "query" "joins"])
(map #(get % "alias"))
set)]
(if (seq join-aliases)
(update (get card "visualization_settings") "column_settings"
(fn [column_settings]
(let [copies-with-join-alias (into {}
(mapcat (fn [[k v]]
(match (vec (json/parse-string k))
["ref" ["field" id opts]]
(for [alias join-aliases]
[(json/generate-string ["ref" ["field" id (assoc opts "join-alias" alias)]]) v])
_ '()))
column_settings))]
;; existing column settings should take precedence over the copies in case there is a conflict
(merge copies-with-join-alias column_settings))))
card)))
update-one!
(fn [revision]
(let [card (json/parse-string (:object revision))]
(when (not= (get card "query_type") "native") ; native queries won't have join aliases, so we can exclude them straight away
(let [updated (add-join-aliases card)]
(when (not= updated (get "visualization_settings" card))
(t2/query {:update :revision
:set {:object (json/generate-string (assoc card "visualization_settings" updated))}
:where [:= :id (:id revision)]}))))))]
(run! update-one! (t2/reducible-query {:select [:*]
:from [:revision]
:where [:and
;; only include cards with field refs in column_settings
[:or
[:like :object "%ref\\\\\",[\\\\\"field%"]
[:like :object "%ref\\\\\\\",[\\\\\\\"field%"]]
;; only include cards with joins
[:like :object "%joins%"]
[:= :model "Card"]]})))
;; Reverse migration
(let [update-one!
(fn [revision]
(let [card (json/parse-string (:object revision))]
(when (not= (get card "query_type") "native")
(let [viz-settings (get card "visualization_settings")
updated (remove-join-alias-from-column-settings-field-refs viz-settings)]
(when (not= updated viz-settings)
(t2/query {:update :revision
:set {:object (json/generate-string (assoc card "visualization_settings" updated))}
:where [:= :id (:id revision)]}))))))]
(run! update-one! (t2/reducible-query {:select [:*]
:from [:revision]
:where [:and
[:or
[:like :object "%ref\\\\\",[\\\\\"field%"]
[:like :object "%ref\\\\\\\",[\\\\\\\"field%"]]
[:like :object "%join-alias%"]
[:= :model "Card"]]})))) | |
(define-migration MigrateLegacyDashboardCardColumnSettingsFieldRefs
(let [update-one! (fn [{:keys [id visualization_settings]}]
(let [parsed (json/parse-string visualization_settings)
updated (update-legacy-field-refs-in-viz-settings parsed)]
(when (not= parsed updated)
(t2/query-one {:update :report_dashboardcard
:set {:visualization_settings (json/generate-string updated)}
:where [:= :id id]}))))]
(run! update-one! (t2/reducible-query
{:select [:id :visualization_settings]
:from [:report_dashboardcard]
:where [:and
[:<> :card_id nil]
[:or
;; these match legacy field refs in column_settings
[:like :visualization_settings "%ref\\\\\",[\\\\\"field-id%"]
[:like :visualization_settings "%ref\\\\\",[\\\\\"field-literal%"]
[:like :visualization_settings "%ref\\\\\",[\\\\\"fk->%"]
;; MySQL with NO_BACKSLASH_ESCAPES disabled:
[:like :visualization_settings "%ref\\\\\\\",[\\\\\\\"field-id%"]
[:like :visualization_settings "%ref\\\\\\\",[\\\\\\\"field-literal%"]
[:like :visualization_settings "%ref\\\\\\\",[\\\\\\\"fk->%"]]]})))) | |
(define-reversible-migration AddJoinAliasToDashboardCardColumnSettingsFieldRefs
(let [update-one! (fn [{:keys [id visualization_settings result_metadata]}]
(let [updated (add-join-alias-to-column-settings-refs {:visualization_settings visualization_settings
:result_metadata result_metadata})]
(when (not= visualization_settings updated)
(t2/query-one {:update :report_dashboardcard
:set {:visualization_settings updated}
:where [:= :id id]}))))]
(run! update-one! (t2/reducible-query {:select [:dc.id :dc.visualization_settings :c.result_metadata]
:from [[:report_card :c]]
:join [[:report_dashboardcard :dc] [:= :dc.card_id :c.id]]
:where [:and
[:or
[:= :c.query_type nil]
[:= :c.query_type "query"]]
[:or
[:like :dc.visualization_settings "%ref\\\\\",[\\\\\"field%"]
; MySQL with NO_BACKSLASH_ESCAPES disabled
[:like :dc.visualization_settings "%ref\\\\\\\",[\\\\\\\"field%"]]
[:like :c.result_metadata "%join-alias%"]]})))
(let [update! (fn [{:keys [id visualization_settings]}]
(let [parsed (json/parse-string visualization_settings)
updated (remove-join-alias-from-column-settings-field-refs parsed)]
(when (not= parsed updated)
(t2/query-one {:update :report_dashboardcard
:set {:visualization_settings (json/generate-string updated)}
:where [:= :id id]}))))]
(run! update! (t2/reducible-query {:select [:dc.id :dc.visualization_settings]
:from [[:report_card :c]]
:join [[:report_dashboardcard :dc] [:= :dc.card_id :c.id]]
:where [:and
[:or
[:= :c.query_type nil]
[:= :c.query_type "query"]]
[:or
[:like :dc.visualization_settings "%ref\\\\\",[\\\\\"field%"]
[:like :dc.visualization_settings "%ref\\\\\\\",[\\\\\\\"field%"]]
[:like :dc.visualization_settings "%join-alias%"]]})))) | |
(define-migration RevisionMigrateLegacyDashboardCardColumnSettingsFieldRefs
(let [update-one! (fn [{:keys [id object]}]
(let [object (json/parse-string object)
updated (update object "cards" (fn [cards]
(map #(update % "visualization_settings" update-legacy-field-refs-in-viz-settings) cards)))]
(when (not= updated object)
(t2/query-one {:update :revision
:set {:object (json/generate-string updated)}
:where [:= :id id]}))))]
(run! update-one! (t2/reducible-query {:select [:id :object]
:from [:revision]
:where [:and
[:= :model "Dashboard"]
[:or
;; these match legacy field refs in column_settings
[:like :object "%ref\\\\\",[\\\\\"field-id%"]
[:like :object "%ref\\\\\",[\\\\\"field-literal%"]
[:like :object "%ref\\\\\",[\\\\\"fk->%"]
;; MySQL with NO_BACKSLASH_ESCAPES disabled:
[:like :object "%ref\\\\\\\",[\\\\\\\"field-id%"]
[:like :object "%ref\\\\\\\",[\\\\\\\"field-literal%"]
[:like :object "%ref\\\\\\\",[\\\\\\\"fk->%"]]]})))) | |
(define-reversible-migration RevisionAddJoinAliasToDashboardCardColumnSettingsFieldRefs
(let [add-join-aliases
(fn [dashcard]
(if-let [{:keys [dataset_query]} (t2/query-one {:select [:dataset_query]
:from [:report_card]
:where [:and
[:or
;; native queries won't have join aliases, so we can exclude them
[:= :query_type nil]
[:= :query_type "query"]]
[:= :id (get dashcard "card_id")]
;; only include cards with joins
[:like :dataset_query "%joins%"]]})]
(if-let [join-aliases (->> (get-in (json/parse-string dataset_query) ["query" "joins"])
(map #(get % "alias"))
set
seq)]
(m/update-existing-in dashcard ["visualization_settings" "column_settings"]
(fn [column_settings]
(let [copies-with-join-alias (into {}
(mapcat (fn [[k v]]
(match (vec (json/parse-string k))
["ref" ["field" id opts]]
(for [alias join-aliases]
[(json/generate-string ["ref" ["field" id (assoc opts "join-alias" alias)]]) v])
_ '()))
column_settings))]
;; existing column settings should take precedence over the copies in case there is a conflict
(merge copies-with-join-alias column_settings))))
dashcard)
dashcard))
update-one!
(fn [revision]
(let [dashboard (json/parse-string (:object revision))
updated (update dashboard "cards" (fn [dashcards]
(map add-join-aliases dashcards)))]
(when (not= updated dashboard)
(t2/query {:update :revision
:set {:object (json/generate-string updated)}
:where [:= :id (:id revision)]}))))]
(run! update-one! (t2/reducible-query {:select [:*]
:from [:revision]
:where [:and
[:= :model "Dashboard"]
;; only include cards with field refs in column_settings
[:or
[:like :object "%ref\\\\\",[\\\\\"field%"]
[:like :object "%ref\\\\\\\",[\\\\\\\"field%"]]]})))
;; Reverse migration
(let [update-one!
(fn [revision]
(let [dashboard (json/parse-string (:object revision))
updated (update dashboard "cards"
(fn [dashcards]
(map #(update % "visualization_settings" remove-join-alias-from-column-settings-field-refs)
dashcards)))]
(when (not= updated dashboard)
(t2/query {:update :revision
:set {:object (json/generate-string updated)}
:where [:= :id (:id revision)]}))))]
(run! update-one! (t2/reducible-query {:select [:*]
:from [:revision]
:where [:and
[:= :model "Dashboard"]
[:or
[:like :object "%ref\\\\\",[\\\\\"field%"]
[:like :object "%ref\\\\\\\",[\\\\\\\"field%"]]
[:like :object "%join-alias%"]]})))) | |
(define-reversible-migration MigrateDatabaseOptionsToSettings
(let [update-one! (fn [{:keys [id settings options]}]
(let [settings (mi/encrypted-json-out settings)
options (mi/json-out-with-keywordization options)
new-settings (mi/encrypted-json-in (merge settings options))]
(t2/query {:update :metabase_database
:set {:settings new-settings}
:where [:= :id id]})))]
(run! update-one! (t2/reducible-query {:select [:id :settings :options]
:from [:metabase_database]
:where [:and
[:not= :options ]
[:not= :options "{}"]
[:not= :options nil]]})))
(let [rollback-one! (fn [{:keys [id settings options]}]
(let [settings (mi/encrypted-json-out settings)
options (mi/json-out-with-keywordization options)]
(when (some? (:persist-models-enabled settings))
(t2/query {:update :metabase_database
:set {:options (json/generate-string (select-keys settings [:persist-models-enabled]))
:settings (mi/encrypted-json-in (dissoc settings :persist-models-enabled))}
:where [:= :id id]}))))]
(run! rollback-one! (t2/reducible-query {:select [:id :settings :options]
:from [:metabase_database]})))) | |
Fix click through migration | |
Fixes click behavior settings on dashcards, returns nil if no fix available. Format changed from:
at the top level and
{... viewas linktemplate link_text ...} to at the column_settings level. Scours the card to find all click behavior, reshapes it, and deep merges it into the reshapen dashcard. scour for all links in the card, fixup the dashcard and then merge in any new click_behaviors from the card. See extensive tests for different scenarios. We are in a migration so this returns nil if there is nothing to do so that it is filtered and we aren't running sql statements that are replacing data for no purpose. Merging the following click behaviors in order (later merges on top of earlier): - fixed card click behavior - fixed dash click behavior - existing new style dash click behavior | (defn- fix-click-through
[{id :id card :card_visualization dashcard :dashcard_visualization}]
(let [remove-nil-keys (fn [m]
(into {} (remove #(nil? (val %)) m)))
existing-fixed (fn [settings]
(-> settings
(m/update-existing "column_settings"
(fn [column_settings]
(m/map-vals
#(select-keys % ["click_behavior"])
column_settings)))
;; select click behavior top level and in column settings
(select-keys ["column_settings" "click_behavior"])
(remove-nil-keys)))
fix-top-level (fn [toplevel]
(if (= (get toplevel "click") "link")
(assoc toplevel
;; add new shape top level
"click_behavior"
{"type" (get toplevel "click")
"linkType" "url"
"linkTemplate" (get toplevel "click_link_template")})
toplevel))
fix-cols (fn [column-settings]
(reduce-kv
(fn [m col field-settings]
(assoc m col
;; add the click stuff under the new click_behavior entry or keep the
;; field settings as is
(if (and (= (get field-settings "view_as") "link")
(contains? field-settings "link_template"))
;; remove old shape and add new shape under click_behavior
(assoc field-settings
"click_behavior"
{"type" (get field-settings "view_as")
"linkType" "url"
"linkTemplate" (get field-settings "link_template")
"linkTextTemplate" (get field-settings "link_text")})
field-settings)))
{}
column-settings))
fixed-card (-> (if (contains? dashcard "click")
(dissoc card "click_behavior") ;; throw away click behavior if dashcard has click
;; behavior added
(fix-top-level card))
(update "column_settings" fix-cols) ;; fix columns and then select only the new shape from
;; the settings tree
existing-fixed)
fixed-dashcard (update (fix-top-level dashcard) "column_settings" fix-cols)
final-settings (->> (m/deep-merge fixed-card fixed-dashcard (existing-fixed dashcard))
;; remove nils and empty maps _AFTER_ deep merging so that the shapes are
;; uniform. otherwise risk not fully clobbering an underlying form if the one going on top
;; doesn't have link text
(walk/postwalk (fn [form]
(if (map? form)
(into {} (for [[k v] form
:when (if (seqable? v)
;; remove keys with empty maps. must be postwalk
(seq v)
;; remove nils
(some? v))]
[k v]))
form))))]
(when (not= final-settings dashcard)
{:id id
:visualization_settings final-settings}))) |
(defn- parse-to-json [& ks]
(fn [x]
(reduce #(update %1 %2 json/parse-string)
x
ks))) | |
This was previously a data migration, hence the metadata. The metadata is unused but potentially useful as documentation. | (defn- migrate-click-through!
{:author "dpsutton"
:added "0.38.1"
:doc "Migration of old 'custom drill-through' to new 'click behavior'; see #15014"}
[]
(transduce (comp (map (parse-to-json :card_visualization :dashcard_visualization))
(map fix-click-through)
(filter :visualization_settings))
(completing
(fn [_ {:keys [id visualization_settings]}]
(t2/update! :report_dashboardcard id
{:visualization_settings (json/generate-string visualization_settings)})))
nil
;; flamber wrote a manual postgres migration that this faithfully recreates: see
;; https://github.com/metabase/metabase/issues/15014
(t2/query {:select [:dashcard.id
[:card.visualization_settings :card_visualization]
[:dashcard.visualization_settings :dashcard_visualization]]
:from [[:report_dashboardcard :dashcard]]
:join [[:report_card :card] [:= :dashcard.card_id :card.id]]
:where [:or
[:like
:card.visualization_settings "%\"link_template\":%"]
[:like
:card.visualization_settings "%\"click_link_template\":%"]
[:like
:dashcard.visualization_settings "%\"link_template\":%"]
[:like
:dashcard.visualization_settings "%\"click_link_template\":%"]]}))) |
(define-migration MigrateClickThrough (migrate-click-through!)) | |
Removing admin from group mapping migration | |
Get raw setting directly from DB. For some reasons during data-migration [[metabase.models.setting/get]] return the default value defined in [[metabase.models.setting/defsetting]] instead of value from Setting table. | (defn- raw-setting [k] (t2/select-one-fn :value :setting :key (name k))) |
(defn- remove-admin-group-from-mappings-by-setting-key!
[mapping-setting-key]
(let [admin-group-id (t2/select-one-pk :permissions_group :name "Administrators")
mapping (try
(json/parse-string (raw-setting mapping-setting-key))
(catch Exception _e
{}))]
(when-not (empty? mapping)
(t2/update! :setting {:key (name mapping-setting-key)}
{:value
(->> mapping
(map (fn [[k v]] [k (filter #(not= admin-group-id %) v)]))
(into {})
json/generate-string)})))) | |
(defn- migrate-remove-admin-from-group-mapping-if-needed
{:author "qnkhuat"
:added "0.43.0"
:doc "In the past we have a setting to disable group sync for admin group when using SSO or LDAP, but it's broken
and haven't really worked (see #13820).
In #20991 we remove this option entirely and make sync for admin group just like a regular group.
But on upgrade, to make sure we don't unexpectedly begin adding or removing admin users:
- for LDAP, if the `ldap-sync-admin-group` toggle is disabled, we remove all mapping for the admin group
- for SAML, JWT, we remove all mapping for admin group, because they were previously never being synced
if `ldap-sync-admin-group` has never been written, getting raw-setting will return a `nil`, and nil could
also be interpreted as disabled. so checking `(not= x \"true\")` is safer than `(= x \"false\")`."}
[]
(when (not= (raw-setting :ldap-sync-admin-group) "true")
(remove-admin-group-from-mappings-by-setting-key! :ldap-group-mappings))
;; sso are enterprise feature but we still run this even in OSS in case a customer
;; have switched from enterprise -> SSO and stil have this mapping in Setting table
(remove-admin-group-from-mappings-by-setting-key! :jwt-group-mappings)
(remove-admin-group-from-mappings-by-setting-key! :saml-group-mappings)) | |
(define-migration MigrateRemoveAdminFromGroupMappingIfNeeded (migrate-remove-admin-from-group-mapping-if-needed)) | |
Each unified column is 3 items sequence [table-name, column-name, is-nullable?] | (defn- db-type->to-unified-columns
[db-type]
(case db-type
:h2 [[:activity :timestamp false]
[:application_permissions_revision :created_at false]
[:collection_permission_graph_revision :created_at false]
[:core_session :created_at false]
[:core_user :date_joined false]
[:core_user :last_login true]
[:core_user :updated_at true]
[:dependency :created_at false]
[:dimension :created_at false]
[:dimension :updated_at false]
[:metabase_database :created_at false]
[:metabase_database :updated_at false]
[:metabase_field :created_at false]
[:metabase_field :updated_at false]
[:metabase_field :last_analyzed true]
[:metabase_fieldvalues :created_at false]
[:metabase_table :created_at false]
[:metabase_table :updated_at false]
[:metric :created_at false]
[:metric :updated_at false]
[:permissions_revision :created_at false]
[:pulse :created_at false]
[:pulse :updated_at false]
[:pulse_channel :created_at false]
[:pulse_channel :updated_at false]
[:recent_views :timestamp false]
[:report_card :created_at false]
[:report_cardfavorite :created_at false]
[:report_cardfavorite :updated_at false]
[:report_dashboard :created_at false]
[:report_dashboard :updated_at false]
[:report_dashboardcard :created_at false]
[:report_dashboardcard :updated_at false]
[:segment :created_at false]
[:segment :updated_at false]]
:mysql [[:activity :timestamp false]
[:application_permissions_revision :created_at false]
[:collection_permission_graph_revision :created_at false]
[:core_session :created_at false]
[:core_user :date_joined false]
[:core_user :last_login true]
[:core_user :updated_at true]
[:dependency :created_at false]
[:dimension :created_at false]
[:dimension :updated_at false]
[:metabase_field :created_at false]
[:metabase_field :last_analyzed true]
[:metabase_field :updated_at false]
[:metabase_fieldvalues :created_at false]
[:metabase_table :created_at false]
[:metabase_table :updated_at false]
[:metric :created_at false]
[:metric :updated_at false]
[:permissions_revision :created_at false]
[:pulse :created_at false]
[:pulse :updated_at false]
[:pulse_channel :created_at false]
[:pulse_channel :updated_at false]
[:recent_views :timestamp false]
[:report_card :created_at false]
[:report_cardfavorite :created_at false]
[:report_cardfavorite :updated_at false]
[:report_dashboard :created_at false]
[:report_dashboard :updated_at false]
[:segment :created_at false]
[:segment :updated_at false]]
:postgres [[:application_permissions_revision :created_at false]
[:collection_permission_graph_revision :created_at false]
[:core_user :updated_at true]
[:dimension :updated_at false]
[:dimension :created_at false]
[:permissions_revision :created_at false]
[:recent_views :timestamp false]])) |
(defn- alter-table-column-type-sql
[db-type table column ttype nullable?]
(let [ttype (name ttype)
db-type (if (and (= db-type :mysql)
(with-open [conn (.getConnection (mdb.connection/data-source))]
(= "MariaDB" (.getDatabaseProductName (.getMetaData conn)))))
:mariadb
db-type)]
(case db-type
:postgres
(format "ALTER TABLE \"%s\" ALTER COLUMN \"%s\" TYPE %s USING (\"%s\"::%s), ALTER COLUMN %s %s"
table column ttype column ttype column (if nullable? "DROP NOT NULL" "SET NOT NULL"))
:mysql
(format "ALTER TABLE `%s` MODIFY `%s` %s %s"
table column ttype (if nullable? "NULL" "NOT NULL"))
;; maridb will automatically add extra on update set current_timestamp if you don't have a default value for not
;; nullable columns.
;; We don't want this property for created_at columns. so adding a default value here to avoid that default extra
:mariadb
(format "ALTER TABLE `%s` MODIFY `%s` %s %s"
table column ttype (if nullable? "NULL" "NOT NULL DEFAULT CURRENT_TIMESTAMP"))
:h2
(format "ALTER TABLE \"%s\" ALTER COLUMN \"%s\" %s %s"
(upper-case-en table) (upper-case-en column) ttype (if nullable? "NULL" "NOT NULL"))))) | |
(defn- unify-time-column-type!
[direction]
(let [db-type (mdb.connection/db-type)
columns (db-type->to-unified-columns db-type)
timestamp-type (case db-type
(:postgres :h2) "TIMESTAMP WITH TIME ZONE"
:mysql "TIMESTAMP(6)")
datetime-type (case db-type
(:postgres :h2) "TIMESTAMP WITHOUT TIME ZONE"
:mysql "DATETIME")
target-type (case direction
:up timestamp-type
:down datetime-type)]
(doseq [[table column nullable?] columns
;; core_user.updated_at is referenced in a view in postgres, and PG doesn't allow changing column types if a
;; view depends on it. so we need to drop the view before changing the type, then re-create it again
:let [is-pg-specical-case? (= [db-type table column]
[:postgres :core_user :updated_at])]]
(when is-pg-specical-case?
(t2/query [(format "DROP VIEW IF EXISTS v_users;")]))
(t2/query [(alter-table-column-type-sql db-type (name table) (name column) target-type nullable?)])
(when is-pg-specical-case?
(t2/query [(slurp (io/resource "migrations/instance_analytics_views/users/v1/postgres-users.sql"))]))))) | |
(define-reversible-migration UnifyTimeColumnsType (unify-time-column-type! :up) (unify-time-column-type! :down)) | |
(ns metabase.db.data-source (:require [clojure.set :as set] [clojure.string :as str] [metabase.config :as config] [metabase.connection-pool :as connection-pool] [metabase.db.spec :as mdb.spec] [metabase.db.update-h2 :as update-h2] [metabase.util.log :as log] [potemkin :as p] [pretty.core :as pretty]) (:import (java.sql DriverManager) (java.util Properties))) | |
(set! *warn-on-reflection* true) | |
(p/deftype+ DataSource [^String url ^Properties properties]
pretty/PrettyPrintable
(pretty [_]
;; in dev we can actually print out the details, it's useful in debugging. Everywhere else we should obscure them
;; because they're potentially sensitive.
(if config/is-dev?
(list `->DataSource url properties)
(list `->DataSource (symbol "#_REDACTED") (symbol "#_REDACTED"))))
javax.sql.DataSource
(getConnection [_]
(update-h2/update-if-needed! url)
(if properties
(DriverManager/getConnection url properties)
(DriverManager/getConnection url)))
;; we don't use (.getConnection this url user password) so we don't need to implement it.
(getConnection [_ _user _password]
(throw (UnsupportedOperationException. "Use (.getConnection this) instead.")))
Object
(equals [_ another]
(and (instance? DataSource another)
(= (.url ^DataSource another) url)
(= (.properties ^DataSource another) properties)))
(toString [this]
(pr-str (pretty/pretty this)))) | |
(alter-meta! #'->DataSource assoc :private true) | |
Return a [[javax.sql.DataSource]] given a raw JDBC connection string. | (defn raw-connection-string->DataSource
(^javax.sql.DataSource [s]
(raw-connection-string->DataSource s nil nil))
(^javax.sql.DataSource [s username password]
{:pre [(string? s)]}
;; normalize the protocol in case someone is trying to trip us up. Heroku is known for this and passes stuff in
;; like `postgres:...` to screw with us.
(let [s (cond-> s
(str/starts-with? s "postgres:") (str/replace-first #"^postgres:" "postgresql:")
(not (str/starts-with? s "jdbc:")) (str/replace-first #"^" "jdbc:"))
;; Even tho they're invalid we need to handle strings like `postgres://user:password@host:port` for legacy
;; reasons. (I think this is also how some places like Heroku ship them in order to make our lives hard) So
;; strip those out with the absolute minimum of parsing we can get away with and then pass them in separately
;; -- see #14678 and #20121
;;
;; NOTE: if password is URL-encoded this isn't going to work, since we're not URL-decoding it. I don't think
;; that's a problem we really have to worry about, and at any rate we have never supported it. We did
;; URL-decode things at one point, but that was only because [[clojure.java.jdbc]] tries to parse connection
;; strings itself if you let it -- see #14836. We never let it see connection strings anymore, so that
;; shouldn't be a problem. At any rate #20122 would probably solve most people's problems if their password
;; contains special characters.
[s m] (if-let [[_ subprotocol user password more] (re-find #"^jdbc:((?:postgresql)|(?:mysql))://([^:@]+)(?::([^@:]+))?@(.+$)" s)]
[(str "jdbc:" subprotocol "://" more)
(merge {:user user}
(when (seq password)
{:password password}))]
[s nil])
;; these can't be i18n'ed because the app DB isn't set up yet
_ (when (and (:user m) (seq username))
(log/error "Connection string contains a username, but MB_DB_USER is specified. MB_DB_USER will be used."))
_ (when (and (:password m) (seq password))
(log/error "Connection string contains a password, but MB_DB_PASS is specified. MB_DB_PASS will be used."))
m (cond-> m
(seq username) (assoc :user username)
(seq password) (assoc :password password))]
(->DataSource s (some-> (not-empty m) connection-pool/map->properties))))) |
Return a [[javax.sql.DataSource]] given a broken-out Metabase connection details. | (defn broken-out-details->DataSource
^javax.sql.DataSource [db-type details]
{:pre [(keyword? db-type) (map? details)]}
(let [{:keys [subprotocol subname], :as spec} (mdb.spec/spec db-type (set/rename-keys details {:dbname :db}))
_ (assert subprotocol)
_ (assert subname)
url (format "jdbc:%s:%s" subprotocol subname)
properties (some-> (not-empty (dissoc spec :classname :subprotocol :subname))
connection-pool/map->properties)]
(->DataSource url properties))) |
Logic related to fetching and working with the connection details for the application database. These are provided by
environment variables -- either as a single JDBC connection URL string ( There are three ways you can specify application JDBC connection information for Metabase:
This namespace exposes the vars [[db-type]] and [[data-source]] based on the aforementioned environment variables. Normally you should use the equivalent functions in [[metabase.db.connection]] which can be overridden rather than using this namespace directly. | (ns metabase.db.env (:require [clojure.java.io :as io] [clojure.string :as str] [metabase.config :as config] [metabase.db.data-source :as mdb.data-source] [metabase.util :as u] [metabase.util.log :as log] [metabase.util.malli :as mu])) |
(set! *warn-on-reflection* true) | |
[[env->db-type]] | |
(defn- raw-connection-string->type [s]
(when (seq s)
(when-let [[_protocol subprotocol] (re-find #"^(?:jdbc:)?([^:]+):" s)]
(condp = subprotocol
"postgresql" :postgres
(keyword subprotocol))))) | |
(mu/defn ^:private env->db-type :- [:enum :postgres :mysql :h2]
[{:keys [mb-db-connection-uri mb-db-type]}]
(or (some-> mb-db-connection-uri raw-connection-string->type)
mb-db-type)) | |
[[env->DataSource]] | |
Takes a filename and converts it to H2-compatible filename. | (defn- get-db-file [db-file-name] ;; H2 wants file path to always be absolute (str "file:" (.getAbsolutePath (io/file db-file-name)))) |
(defn- env->db-file
[{:keys [mb-db-in-memory mb-db-file]}]
(if mb-db-in-memory
;; In-memory (i.e. test) DB
"mem:metabase"
;; File-based DB
(get-db-file mb-db-file))) | |
(def ^:private h2-connection-properties
;; see https://h2database.com/html/features.html for explanation of options
{;; DB_CLOSE_DELAY=-1 = don't close the Database until the JVM shuts down
:DB_CLOSE_DELAY -1
;; we need to enable MVCC for Quartz JDBC backend to work! Quartz depends on row-level locking, which means without
;; MVCC we "will experience dead-locks". MVCC is the default for everyone using the MVStore engine anyway so this
;; only affects people still with legacy PageStore databases
:MVCC true
;; Tell H2 to defrag when Metabase is shut down -- can reduce DB size by multiple GIGABYTES -- see #6510
:DEFRAG_ALWAYS true
;; LOCK_TIMEOUT=60000 = wait up to one minute to acquire table lock instead of default of 1 second
:LOCK_TIMEOUT 60000}) | |
Connection details that can be used when pretending the Metabase DB is itself a | (defn- broken-out-details
[db-type {:keys [mb-db-dbname mb-db-host mb-db-pass mb-db-port mb-db-user], :as env-vars}]
(if (= db-type :h2)
(assoc h2-connection-properties
:db (env->db-file env-vars))
{:host mb-db-host
:port mb-db-port
:db mb-db-dbname
:user mb-db-user
:password mb-db-pass})) |
(defn- env->DataSource
[db-type {:keys [mb-db-connection-uri mb-db-user mb-db-pass], :as env-vars}]
(if mb-db-connection-uri
(mdb.data-source/raw-connection-string->DataSource mb-db-connection-uri mb-db-user mb-db-pass)
(mdb.data-source/broken-out-details->DataSource db-type (broken-out-details db-type env-vars)))) | |
exports: [[db-type]], [[db-file]], and [[data-source]] created using environment variables. | |
(defmulti ^:private env-defaults
{:arglists '([db-type])}
keyword) | |
(defmethod env-defaults :h2 [_db-type] nil) | |
(defmethod env-defaults :mysql
[_db-type]
{:mb-db-host "localhost"
:mb-db-port 3306}) | |
(defmethod env-defaults :postgres
[_db-type]
{:mb-db-host "localhost"
:mb-db-port 5432}) | |
(defn- env* [db-type]
(merge-with
(fn [env-value default-value]
(if (nil? env-value)
default-value
env-value))
{:mb-db-type db-type
:mb-db-in-memory (config/config-bool :mb-db-in-memory)
:mb-db-file (config/config-str :mb-db-file)
:mb-db-connection-uri (config/config-str :mb-db-connection-uri)
:mb-db-host (config/config-str :mb-db-host)
:mb-db-port (config/config-int :mb-db-port)
:mb-db-dbname (config/config-str :mb-db-dbname)
:mb-db-user (config/config-str :mb-db-user)
:mb-db-pass (config/config-str :mb-db-pass)}
(env-defaults db-type))) | |
Metabase Datatbase environment. Used to setup application-db and audit-db for enterprise users. | (def env (env* (config/config-kw :mb-db-type))) |
Keyword type name of the application DB details specified by environment variables. Matches corresponding driver
name e.g. | (def db-type (env->db-type env)) |
(when (= db-type :h2)
(log/warn
(u/format-color
:red
;; Unfortunately this can't be i18n'ed because the application DB hasn't been initialized yet at the time we log
;; this and thus the site locale is unavailable.
(str/join
" "
["WARNING: Using Metabase with an H2 application database is not recommended for production deployments."
"For production deployments, we highly recommend using Postgres, MySQL, or MariaDB instead."
"If you decide to continue to use H2, please be sure to back up the database file regularly."
"For more information, see https://metabase.com/docs/latest/operations-guide/migrating-from-h2.html"])))) | |
Path to our H2 DB file from env var or app config. | (defn db-file [] (env->db-file env)) |
If someone is using Postgres and specifies | (when-let [raw-connection-string (not-empty (:mb-db-connection-uri env))]
(when (and (= db-type :postgres)
(str/includes? raw-connection-string "ssl=true")
(not (str/includes? raw-connection-string "sslmode=require")))
;; Unfortunately this can't be i18n'ed because the application DB hasn't been initialized yet at the time we log
;; this and thus the site locale is unavailable.
(log/warn (str/join " " ["Warning: Postgres connection string with `ssl=true` detected."
"You may need to add `?sslmode=require` to your application DB connection string."
"If Metabase fails to launch, please add it and try again."
"See https://github.com/metabase/metabase/issues/8908 for more details."])))) |
A [[javax.sql.DataSource]] ultimately derived from the environment variables. | (def ^javax.sql.DataSource data-source (env->DataSource db-type env)) |
Implementations of [[clojure.java.jdbc]] and [[next.jdbc]] protocols for the Metabase application database. These
handle type mappings for setting parameters and for reading results from the DB — mainly by automatically converting
CLOBs to Strings and using new | (ns metabase.db.jdbc-protocols (:require [clojure.java.jdbc :as jdbc] [clojure.string :as str] [java-time.api :as t] [metabase.db.connection :as mdb.connection] [metabase.util :as u] [metabase.util.date-2 :as u.date] [metabase.util.log :as log] [methodical.core :as methodical] [next.jdbc.prepare] [toucan2.jdbc.read :as t2.jdbc.read]) (:import (java.io BufferedReader) (java.sql PreparedStatement ResultSet ResultSetMetaData Types) (java.time Instant LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime ZonedDateTime))) |
(set! *warn-on-reflection* true) | |
(defn- set-object [^PreparedStatement stmt ^Integer index object ^Integer target-sql-type] (.setObject stmt index object target-sql-type)) | |
(extend-protocol jdbc/ISQLParameter
;; DB's don't seem to handle Instant correctly so convert it to an OffsetDateTime with zone offset = 0
Instant
(set-parameter [t stmt i]
(jdbc/set-parameter (t/offset-date-time t (t/zone-offset 0)) stmt i))
LocalDate
(set-parameter [t stmt i]
(set-object stmt i t Types/DATE))
LocalDateTime
(set-parameter [t stmt i]
(set-object stmt i t Types/TIMESTAMP))
LocalTime
(set-parameter [t stmt i]
(set-object stmt i t Types/TIME))
OffsetDateTime
(set-parameter [t stmt i]
(if (= (mdb.connection/db-type) :mysql)
;; Regardless of session timezone it seems to be the case that OffsetDateTimes get normalized to UTC inside MySQL
;;
;; Since MySQL TIMESTAMPs aren't timezone-aware this means comparisons are done between timestamps in the report
;; timezone and the local datetime portion of the parameter, in UTC. Bad!
;;
;; Convert it to a LocalDateTime, in the report timezone, so comparisions will work correctly.
;;
;; See also — https://dev.mysql.com/doc/refman/5.5/en/datetime.html
(let [offset (.. (t/zone-id) getRules (getOffset (t/instant t)))
t (t/local-date-time (t/with-offset-same-instant t offset))]
(set-object stmt i t Types/TIMESTAMP))
;; h2 and Postgres work as expected
(set-object stmt i t Types/TIMESTAMP_WITH_TIMEZONE)))
;; MySQL, Postgres, and H2 all don't support OffsetTime
OffsetTime
(set-parameter [t stmt i]
(set-object stmt i (t/local-time (t/with-offset-same-instant t (t/zone-offset 0))) Types/TIME))
;; Similarly, none of them handle ZonedDateTime out of the box either, so convert it to an OffsetDateTime first
ZonedDateTime
(set-parameter [t stmt i]
(jdbc/set-parameter (t/offset-date-time t) stmt i))
;; JDBC drivers don't know about Clojure ratios. So just set them as a double instead. That should be ok enough for
;; now.
clojure.lang.Ratio
(set-parameter [ratio stmt i]
(jdbc/set-parameter (double ratio) stmt i))) | |
Convert an H2 clob to a String. | (defn clob->str
^String [^org.h2.jdbc.JdbcClob clob]
(when clob
(letfn [(->str [^BufferedReader buffered-reader]
(loop [acc []]
(if-let [line (.readLine buffered-reader)]
(recur (conj acc line))
(str/join "\n" acc))))]
(with-open [reader (.getCharacterStream clob)]
(if (instance? BufferedReader reader)
(->str reader)
(with-open [buffered-reader (BufferedReader. reader)]
(->str buffered-reader))))))) |
(extend-protocol jdbc/IResultSetReadColumn
org.postgresql.util.PGobject
(result-set-read-column [clob _ _]
(.getValue clob))
org.h2.jdbc.JdbcClob
(result-set-read-column [clob _ _]
(clob->str clob))
org.h2.jdbc.JdbcBlob
(result-set-read-column [^org.h2.jdbc.JdbcBlob blob _ _]
(.getBytes blob 0 (.length blob)))) | |
(defmulti ^:private read-column
{:arglists '([rs rsmeta i])}
(fn [_ ^ResultSetMetaData rsmeta ^Integer i]
(.getColumnType rsmeta i))) | |
(defmethod read-column :default [^ResultSet rs _ ^Integer i] (.getObject rs i)) | |
(defmethod read-column Types/TIMESTAMP
[^ResultSet rs ^ResultSetMetaData rsmeta ^Integer i]
(case (mdb.connection/db-type)
:postgres
;; for some reason postgres `TIMESTAMP WITH TIME ZONE` columns still come back as `Type/TIMESTAMP`, which seems
;; like a bug with the JDBC driver?
(let [^Class klass (if (= (u/lower-case-en (.getColumnTypeName rsmeta i)) "timestamptz")
OffsetDateTime
LocalDateTime)]
(.getObject rs i klass))
:mysql
;; MySQL TIMESTAMPS are actually TIMESTAMP WITH LOCAL TIME ZONE, i.e. they are stored normalized to UTC when stored.
;; However, MySQL returns them in the report time zone in an effort to make our lives horrible.
;;
;; Check and see if the column type is `TIMESTAMP` (as opposed to `DATETIME`, which is the equivalent of
;; LocalDateTime), and normalize it to a UTC timestamp if so.
(when-let [t (.getObject rs i LocalDateTime)]
(if (= (.getColumnTypeName rsmeta i) "TIMESTAMP")
(t/with-offset-same-instant (t/offset-date-time t (t/zone-id)) (t/zone-offset 0))
t))
;; h2
(.getObject rs i LocalDateTime))) | |
(defmethod read-column Types/TIMESTAMP_WITH_TIMEZONE [^ResultSet rs _ ^Integer i] (.getObject rs i OffsetDateTime)) | |
(defmethod read-column Types/DATE [^ResultSet rs _ ^Integer i] (.getObject rs i LocalDate)) | |
(defmethod read-column Types/TIME
[^ResultSet rs _ ^Integer i]
(case (mdb.connection/db-type)
:postgres
;; Sometimes Postgres times come back as strings like `07:23:18.331+00` (no minute in offset) and there's a bug in
;; the JDBC driver where it can't parse those correctly. We can do it ourselves in that case.
(try
(.getObject rs i LocalTime)
(catch Throwable _
(when-let [s (.getString rs i)]
(log/tracef "Error in Postgres JDBC driver reading TIME value, fetching as string '%s'" s)
(u.date/parse s))))
;; H2 & MySQL work as expected
(.getObject rs i LocalTime))) | |
(defmethod read-column Types/TIME_WITH_TIMEZONE [^ResultSet rs _ ^Integer i] (.getObject rs i OffsetTime)) | |
Default | (defn read-columns
[rs rsmeta indexes]
(mapv
(fn [i]
(-> (read-column rs rsmeta i)
(jdbc/result-set-read-column rsmeta i)))
indexes)) |
[[next.jdbc]] and Toucan 2 mappings | |
(extend-protocol next.jdbc.prepare/SettableParameter
;; DB's don't seem to handle Instant correctly so convert it to an OffsetDateTime with zone offset = 0
Instant
(set-parameter [t stmt i]
(jdbc/set-parameter (t/offset-date-time t (t/zone-offset 0)) stmt i))
ZonedDateTime
(set-parameter [t stmt i]
(next.jdbc.prepare/set-parameter (t/offset-date-time t) stmt i))
clojure.lang.Ratio
(set-parameter [ratio stmt i]
(next.jdbc.prepare/set-parameter (double ratio) stmt i))) | |
(methodical/defmethod t2.jdbc.read/read-column-thunk [:default :default java.sql.Types/OTHER]
"Read Postgres `citext` columns out as Strings."
[^java.sql.Connection conn model ^java.sql.ResultSet rset ^java.sql.ResultSetMetaData rsmeta ^Long i]
(if (= (.getColumnTypeName rsmeta i) "citext")
(fn get-citext-as-string []
(.getString rset i))
(next-method conn model rset rsmeta i))) | |
High-level Clojure wrapper around relevant parts of the Liquibase API. | (ns metabase.db.liquibase (:require [clojure.java.jdbc :as jdbc] [clojure.string :as str] [metabase.config :as config] [metabase.db.custom-migrations] [metabase.db.liquibase.h2 :as liquibase.h2] [metabase.db.liquibase.mysql :as liquibase.mysql] [metabase.plugins.classloader :as classloader] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.connection :as t2.conn]) (:import (java.io StringWriter) (java.util List Map) (liquibase Contexts LabelExpression Liquibase RuntimeEnvironment Scope Scope$Attr Scope$ScopedRunner) (liquibase.change.custom CustomChangeWrapper) (liquibase.changelog ChangeLogIterator ChangeSet ChangeSet$ExecType) (liquibase.changelog.filter ChangeSetFilter) (liquibase.changelog.visitor AbstractChangeExecListener ChangeExecListener UpdateVisitor) (liquibase.database Database DatabaseFactory) (liquibase.database.jvm JdbcConnection) (liquibase.exception LockException) (liquibase.lockservice LockService LockServiceFactory) (liquibase.resource ClassLoaderResourceAccessor))) |
(set! *warn-on-reflection* true) | |
(comment ;; load our custom migrations metabase.db.custom-migrations/keep-me) | |
register our custom MySQL SQL generators | (liquibase.mysql/register-mysql-generators!) |
Liquibase uses java.util.logging (JUL) for logging, so we need to install the JUL -> Log4j2 bridge which replaces the default JUL handler with one that "writes" log messages to Log4j2. (Not sure this is the best place in the world to do this, but Liquibase is the only thing using JUL directly.) See https://logging.apache.org/log4j/2.x/log4j-jul/index.html for more information. | (org.apache.logging.log4j.jul.Log4jBridgeHandler/install true nil true) |
Liquibase logs a message for every ChangeSet directly to standard out -- see https://github.com/liquibase/liquibase/issues/2396 -- but we can disable this by setting the ConsoleUIService's output stream to the null output stream | (doto ^liquibase.ui.ConsoleUIService (.getUI (Scope/getCurrentScope)) ;; we can't use `java.io.OutputStream/nullOutputStream` here because it's not available on Java 8 (.setOutputStream (java.io.PrintStream. (org.apache.commons.io.output.NullOutputStream.)))) |
Liquibase setting used for upgrading instances running version < 45. | (def ^{:private true
:doc }
^String changelog-legacy-file "liquibase_legacy.yaml") |
Liquibase setting used for upgrading a fresh instance or instances running version >= 45. | (def ^{:private true
:doc }
^String changelog-file "liquibase.yaml") |
Return the proper changelog table name based on db type of the connection. | (defn changelog-table-name
[^java.sql.Connection conn]
(if (= "PostgreSQL" (-> conn .getMetaData .getDatabaseProductName))
"databasechangelog"
"DATABASECHANGELOG")) |
Check if a table exists. | (defn table-exists?
[table-name ^java.sql.Connection conn]
(-> (.getMetaData conn)
(.getTables nil nil table-name (u/varargs String ["TABLE"]))
jdbc/metadata-query
seq
boolean)) |
(defn- fresh-install? [^java.sql.Connection conn] (not (table-exists? (changelog-table-name conn) conn))) | |
(defn- decide-liquibase-file
[^java.sql.Connection conn]
(if (fresh-install? conn)
changelog-file
(let [latest-migration (->> (jdbc/query {:connection conn}
[(format "select id from %s order by dateexecuted desc limit 1" (changelog-table-name conn))])
first
:id)]
(cond
(nil? latest-migration)
changelog-file
;; post-44 installation downgraded to 45
(= latest-migration "v00.00-000")
changelog-file
;; pre 42
(not (str/starts-with? latest-migration "v"))
changelog-legacy-file
(< (->> latest-migration (re-find #"v(\d+)\..*") second parse-long) 45)
changelog-legacy-file
:else
changelog-file)))) | |
(defn- liquibase-connection ^JdbcConnection [^java.sql.Connection jdbc-connection] (JdbcConnection. jdbc-connection)) | |
(defn- h2? [^JdbcConnection liquibase-conn] (str/starts-with? (.getURL liquibase-conn) "jdbc:h2")) | |
(defn- database ^Database [^JdbcConnection liquibase-conn]
(if (h2? liquibase-conn)
(liquibase.h2/h2-database liquibase-conn)
(.findCorrectDatabaseImplementation (DatabaseFactory/getInstance) liquibase-conn))) | |
(defn- liquibase ^Liquibase [^java.sql.Connection conn ^Database database] (Liquibase. ^String (decide-liquibase-file conn) (ClassLoaderResourceAccessor. (classloader/the-classloader)) database)) | |
Impl for [[with-liquibase-macro]]. | (mu/defn do-with-liquibase
[conn-or-data-source :- [:or (ms/InstanceOfClass java.sql.Connection) (ms/InstanceOfClass javax.sql.DataSource)]
f :- fn?]
;; Custom migrations use toucan2, so we need to make sure it uses the same connection with liquibase
(binding [t2.conn/*current-connectable* conn-or-data-source]
(if (instance? java.sql.Connection conn-or-data-source)
(f (->> conn-or-data-source liquibase-connection database (liquibase conn-or-data-source)))
;; closing the `LiquibaseConnection`/`Database` closes the parent JDBC `Connection`, so only use it in combination
;; with `with-open` *if* we are opening a new JDBC `Connection` from a JDBC spec. If we're passed in a `Connection`,
;; it's safe to assume the caller is managing its lifecycle.
(with-open [conn (.getConnection ^javax.sql.DataSource conn-or-data-source)
liquibase-conn (liquibase-connection conn)
database (database liquibase-conn)]
(f (liquibase conn database)))))) |
Execute body with an instance of a (liquibase/with-liquibase [liquibase {:subname :postgres, ...}] (liquibase/migrate-up-if-needed! liquibase)) | (defmacro with-liquibase
{:style/indent 1}
[[liquibase-binding conn-or-data-source] & body]
`(do-with-liquibase
~conn-or-data-source
(fn [~(vary-meta liquibase-binding assoc :tag (symbol (.getCanonicalName Liquibase)))]
~@body))) |
Return a string of SQL containing the DDL statements needed to perform unrun | (defn migrations-sql
^String [^Liquibase liquibase]
;; calling update on custom migrations will execute them, so we ignore it and generates
;; sql for SQL migrations only
(doseq [^ChangeSet change (.listUnrunChangeSets liquibase nil nil)]
(when (instance? CustomChangeWrapper (first (.getChanges change)))
(.setIgnore change true)))
(let [writer (StringWriter.)]
(.update liquibase "" writer)
(.toString writer))) |
Returns a list of unrun migrations. It's a good idea to check to make sure there's actually something to do before running (I'm not 100% sure whether | (defn unrun-migrations [^Liquibase liquibase] (.listUnrunChangeSets liquibase nil (LabelExpression.))) |
Is a migration lock in place for | (defn- migration-lock-exists? ^Boolean [^Liquibase liquibase] (boolean (seq (.listLocks liquibase)))) |
(Attempt to) force release Liquibase migration locks. | (defn force-release-locks! [^Liquibase liquibase] (.forceReleaseLocks liquibase)) |
Attempts to release the liquibase lock if present. Logs but does not bubble up the exception if one occurs as it's intended to be used when a failure has occurred and bubbling up this exception would hide the real exception. | (defn release-lock-if-needed!
[^Liquibase liquibase]
(when (migration-lock-exists? liquibase)
(try
(force-release-locks! liquibase)
(catch Exception e
(log/error e (trs "Unable to release the Liquibase lock after a migration failure")))))) |
Check and make sure the database isn't locked. If it is, sleep for 2 seconds and then retry several times. There's a chance the lock will end up clearing up so we can run migrations normally. | (defn- wait-for-migration-lock-to-be-cleared
[^Liquibase liquibase]
(u/auto-retry 5
(when (migration-lock-exists? liquibase)
(Thread/sleep 2000)
(throw
(LockException.
(str
(trs "Database has migration lock; cannot run migrations.")
" "
(trs "You can force-release these locks by running `java -jar metabase.jar migrate release-locks`."))))))) |
Run any unrun | (defn migrate-up-if-needed!
[^Liquibase liquibase]
(log/info (trs "Checking if Database has unrun migrations..."))
(if (seq (unrun-migrations liquibase))
(do
(log/info (trs "Database has unrun migrations. Waiting for migration lock to be cleared..."))
(wait-for-migration-lock-to-be-cleared liquibase)
;; while we were waiting for the lock, it was possible that another instance finished the migration(s), so make
;; sure something still needs to be done...
(let [unrun-migrations-count (count (unrun-migrations liquibase))]
(if (pos? unrun-migrations-count)
(let [^Contexts contexts nil
start-time (System/currentTimeMillis)]
(log/info (trs "Migration lock is cleared. Running {0} migrations ..." unrun-migrations-count))
(.update liquibase contexts)
(log/info (trs "Migration complete in {0}" (u/format-milliseconds (- (System/currentTimeMillis) start-time)))))
(log/info
(trs "Migration lock cleared, but nothing to do here! Migrations were finished by another instance.")))))
(log/info (trs "No unrun migrations found.")))) |
Run function | (defn run-in-scope-locked
[^Liquibase liquibase f]
(let [database (.getDatabase liquibase)
^LockService lock-service (.getLockService (LockServiceFactory/getInstance) database)
scope-objects {(.name Scope$Attr/database) database
(.name Scope$Attr/resourceAccessor) (.getResourceAccessor liquibase)}]
(Scope/child ^Map scope-objects
(reify Scope$ScopedRunner
(run [_]
(.waitForLock lock-service)
(try
(f)
(finally
(.releaseLock lock-service)))))))) |
Run update with the change log instances in | (defn update-with-change-log
([liquibase]
(update-with-change-log liquibase {}))
([^Liquibase liquibase
{:keys [^List change-set-filters exec-listener]
:or {change-set-filters []}}]
(let [change-log (.getDatabaseChangeLog liquibase)
database (.getDatabase liquibase)
log-iterator (ChangeLogIterator. change-log ^"[Lliquibase.changelog.filter.ChangeSetFilter;" (into-array ChangeSetFilter change-set-filters))
update-visitor (UpdateVisitor. database ^ChangeExecListener exec-listener)
runtime-env (RuntimeEnvironment. database (Contexts.) nil)]
(run-in-scope-locked
liquibase
#(.run ^ChangeLogIterator log-iterator update-visitor runtime-env))))) |
Force migrating up. This does three things differently from [[migrate-up-if-needed!]]:
It can be used to fix situations where the database got into a weird state, as was common before the fixes made in 3295. | (mu/defn force-migrate-up-if-needed!
[^Liquibase liquibase :- (ms/InstanceOfClass Liquibase)]
;; have to do this before clear the checksums else it will wait for locks to be released
(release-lock-if-needed! liquibase)
(.clearCheckSums liquibase)
(when (seq (unrun-migrations liquibase))
(let [change-log (.getDatabaseChangeLog liquibase)
fail-on-errors (mapv (fn [^ChangeSet change-set] [change-set (.getFailOnError change-set)])
(.getChangeSets change-log))
exec-listener (proxy [AbstractChangeExecListener] []
(willRun [^ChangeSet change-set _database-change-log _database _run-status]
(when (instance? ChangeSet change-set)
(log/info (format "Start executing migration with id %s" (.getId change-set)))))
(runFailed [^ChangeSet change-set _database-change-log _database ^Exception e]
(log/error (u/format-color 'red "[ERROR] %s" (.getMessage e))))
(ran [change-set _database-change-log _database ^ChangeSet$ExecType exec-type]
(when (instance? ChangeSet change-set)
(condp = exec-type
ChangeSet$ExecType/EXECUTED
(log/info (u/format-color 'green "[SUCCESS]"))
ChangeSet$ExecType/FAILED
(log/error (u/format-color 'red "[ERROR]"))
(log/info (format "[%s]" (.name exec-type)))))))]
(try
(doseq [^ChangeSet change-set (.getChangeSets change-log)]
(.setFailOnError change-set false))
(update-with-change-log liquibase {:exec-listener exec-listener})
(finally
(doseq [[^ChangeSet change-set fail-on-error?] fail-on-errors]
(.setFailOnError change-set fail-on-error?))))))) |
Consolidate all previous DB migrations so they come from single file. Previously migrations where stored in many small files which added seconds per file to the startup time because liquibase was checking the jar signature for each file. This function is required to correct the liquibase tables to reflect that these migrations were grouped into 2 files. See https://github.com/metabase/metabase/issues/3715 Also see https://github.com/metabase/metabase/pull/34400 | (mu/defn consolidate-liquibase-changesets!
[conn :- (ms/InstanceOfClass java.sql.Connection)]
(let [liquibase-table-name (changelog-table-name conn)
statement (format "UPDATE %s SET FILENAME = CASE WHEN ID = ? THEN ? WHEN ID < ? THEN ? ELSE ? END" liquibase-table-name)]
(when-not (fresh-install? conn)
(jdbc/execute!
{:connection conn}
[statement
"v00.00-000" "migrations/001_update_migrations.yaml"
"v45.00-001" "migrations/000_legacy_migrations.yaml"
"migrations/001_update_migrations.yaml"])))) |
Returns contiguous integers parsed from string s | (defn- extract-numbers [s] (map #(Integer/parseInt %) (re-seq #"\d+" s))) |
Roll back migrations later than given Metabase major version | (defn rollback-major-version
;; default rollback to previous version
([db-type conn liquibase]
;; get current major version of Metabase we are running
(rollback-major-version db-type conn liquibase (dec (config/current-major-version))))
;; with explicit target version
([_db-type conn ^Liquibase liquibase target-version]
(when (or (not (integer? target-version)) (< target-version 44))
(throw (IllegalArgumentException.
(format "target version must be a number between 44 and the previous major version (%d), inclusive"
(config/current-major-version)))))
;; count and rollback only the applied change set ids which come after the target version (only the "v..." IDs need to be considered)
(let [changeset-query (format "SELECT id FROM %s WHERE id LIKE 'v%%' ORDER BY ORDEREXECUTED ASC" (changelog-table-name conn))
changeset-ids (map :id (jdbc/query {:connection conn} [changeset-query]))
;; IDs in changesets do not include the leading 0/1 digit, so the major version is the first number
ids-to-drop (drop-while #(not= (inc target-version) (first (extract-numbers %))) changeset-ids)]
(log/infof "Rolling back app database schema to version %d" target-version)
(.rollback liquibase (count ids-to-drop) "")))) |
Gets the latest version that was applied to the database. | (defn latest-applied-major-version
[conn]
(when-not (fresh-install? conn)
(let [changeset-query (format "SELECT id FROM %s WHERE id LIKE 'v%%' ORDER BY ORDEREXECUTED DESC LIMIT 1" (changelog-table-name conn))
changeset-id (last (map :id (jdbc/query {:connection conn} [changeset-query])))]
(some-> changeset-id extract-numbers first)))) |
Get the latest version that Liquibase would apply if we ran migrations right now. | (defn latest-available-major-version
[^Liquibase liquibase]
(->> liquibase
(.getDatabaseChangeLog)
(.getChangeSets)
(map #(.getId ^ChangeSet %))
last
extract-numbers
first)) |
Custom implementation of the Liquibase H2 adapter that uppercases all identifiers. See #20611 for more details. | (ns metabase.db.liquibase.h2 (:require [metabase.util :as u]) (:import (liquibase.database.core H2Database) (liquibase.database.jvm JdbcConnection))) |
(set! *warn-on-reflection* true) | |
(defn- upcase ^String [s] (some-> s u/upper-case-en)) | |
(defn- h2-database* ^H2Database []
(proxy [H2Database] []
(quoteObject [object-name object-type]
(let [^H2Database this this]
(proxy-super quoteObject (upcase object-name) object-type)))
(mustQuoteObjectName [_object-name _object-type]
true))) | |
HACK! Create a [[java.lang.Package]] for the proxy class if one does not already exist. This is needed because:
This only does anything in REPL-based development; in the uberjar the proxy class will be AOT'ed and will have a package defined for it when it's loaded by the normal JVM classloader rather than the Clojure DynamicClassLoader | (let [klass (class (h2-database*))]
(when-not (.getPackage klass)
(let [method (.getDeclaredMethod
ClassLoader
"definePackage"
(into-array Class [String String String String String String String java.net.URL]))
class-name (.getName klass)
;; e.g. metabase.db.liquibase.h2.proxy$liquibase.database.core
package-name (.substring class-name 0 (.lastIndexOf class-name "."))]
(doto method
(.setAccessible true)
(.invoke (.getClassLoader klass) (into-array Object [package-name nil nil nil nil nil nil nil]))
(.setAccessible false))
(assert (.getPackage klass) (format "Failed to create package for proxy class %s." class-name))))) |
A version of the Liquibase H2 implementation that always converts identifiers to uppercase and then quotes them. | (defn h2-database
^H2Database [^JdbcConnection conn]
(doto (h2-database*)
(.setConnection conn))) |
(ns metabase.db.liquibase.mysql (:require [clojure.string :as str]) (:import (liquibase.database Database) (liquibase.database.core MySQLDatabase) (liquibase.sql Sql UnparsedSql) (liquibase.sqlgenerator SqlGeneratorFactory) (liquibase.sqlgenerator.core AddColumnGenerator CreateTableGenerator SetColumnRemarksGenerator) (liquibase.structure DatabaseObject))) | |
(set! *warn-on-reflection* true) | |
(defn- mysql? [database] (instance? MySQLDatabase database)) | |
Custom generator for | (defn- column-remarks-generator
^SetColumnRemarksGenerator []
(proxy [SetColumnRemarksGenerator] []
(getPriority []
(let [^SetColumnRemarksGenerator this this]
(inc (proxy-super getPriority))))
(supports [statement database]
(let [^SetColumnRemarksGenerator this this]
(and (proxy-super supports statement database)
(mysql? database))))
(generateSql [_statement _database _sql-generator-chain]
(into-array Sql [])))) |
we need a separate ADD COLUMN generator in case an ADD COLUMN migration is being on launch without any CREATE TABLE migrations happening before it | |
It seems like Liquibase actually ignores the | (defn- set-mysql-current-datetime-function! [^Database database] (.setCurrentDateTimeFunction database "current_timestamp(6)")) |
We need generators for both ADD COLUMN and for CREATE TABLE because if we have say just one new migration that is one type or the other then we need to have that specific generator call [[set-mysql-current-datetime-function!]]. TODO -- we should probably add a generate for ADD DEFAULT VALUE too. I assumed this didn't work so for a lot of
MySQL/MariaDB migrations that add defaults values to | |
Custom generator for This uses | (defn- add-column-generator
^AddColumnGenerator []
(proxy [AddColumnGenerator] []
(getPriority []
(let [^AddColumnGenerator this this]
(inc (proxy-super getPriority))))
(supports [statement database]
(let [^AddColumnGenerator this this]
(and (proxy-super supports statement database)
(mysql? database))))
(generateSql [statement database sql-generator-chain]
(set-mysql-current-datetime-function! database)
(let [^AddColumnGenerator this this]
(proxy-super generateSql statement database sql-generator-chain))))) |
Custom generator for
| (defn- create-table-generator
^CreateTableGenerator []
(proxy [CreateTableGenerator] []
(getPriority []
(let [^CreateTableGenerator this this]
(inc (proxy-super getPriority))))
(supports [statement database]
(let [^CreateTableGenerator this this]
(and (proxy-super supports statement database)
(mysql? database))))
(generateSql [statement ^Database database sql-generator-chain]
(set-mysql-current-datetime-function! database)
(let [^CreateTableGenerator this this]
(into-array
Sql
(map (fn [^Sql sql]
(if-not (str/starts-with? (.toSql sql) "CREATE TABLE")
sql
(UnparsedSql. (str (.toSql sql)
" ENGINE InnoDB CHARACTER SET utf8mb4 COLLATE utf8mb4_unicode_ci;")
(into-array DatabaseObject (.getAffectedDatabaseObjects sql)))))
(proxy-super generateSql statement database sql-generator-chain))))))) |
Register our custom MySQL SQL generators. | (defn register-mysql-generators!
[]
(doto (SqlGeneratorFactory/getInstance)
(.register (column-remarks-generator))
(.register (add-column-generator))
(.register (create-table-generator)))) |
Predefined MBQL queries for getting metadata about an external database. TODO -- these have nothing to do with the application database. This namespace should be renamed something like
| (ns metabase.db.metadata-queries (:require [metabase.driver :as driver] [metabase.driver.util :as driver.u] [metabase.mbql.schema :as mbql.s] [metabase.mbql.schema.helpers :as helpers] [metabase.models.table :as table] [metabase.query-processor :as qp] [metabase.query-processor.interface :as qp.i] [metabase.util :as u] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
(defn- qp-query [db-id mbql-query]
{:pre [(integer? db-id)]}
(-> (binding [qp.i/*disable-qp-logging* true]
(qp/process-query
{:type :query
:database db-id
:query mbql-query
:middleware {:disable-remaps? true}}))
:data
:rows)) | |
Given a partition field, returns the default value can be used to query. | (defn- partition-field->filter-form
[field]
(let [field-form [:field (:id field) {:base-type (:base_type field)}]]
(condp #(isa? %2 %1) (:base_type field)
:type/Number [:> field-form -9223372036854775808]
:type/Date [:> field-form "0001-01-01"]
:type/DateTime [:> field-form "0001-01-01T00:00:00"]))) |
(defn- query-with-default-partitioned-field-filter
[query table-id]
(let [;; In bigquery, range or datetime partitioned table can have only one partioned field,
;; Ingestion time partitioned table can use either _PARTITIONDATE or _PARTITIONTIME as
;; partitioned field
partition-field (or (t2/select-one :model/Field
:table_id table-id
:database_partitioned true
:active true
;; prefer _PARTITIONDATE over _PARTITIONTIME for ingestion time query
{:order-by [[:name :asc]]})
(throw (ex-info (format "No partitioned field found for table: %d" table-id)
{:table_id table-id})))
filter-form (partition-field->filter-form partition-field)]
(update query :filter (fn [existing-filter]
(if (some? existing-filter)
[:and existing-filter filter-form]
filter-form))))) | |
(defn- field-mbql-query
[table mbql-query]
(cond-> mbql-query
true
(assoc :source-table (:id table))
;; Some table requires a filter to be able to query the data
;; Currently this only applied to Partitioned table in bigquery where the partition field
;; is required as a filter.
;; In the future we probably want this to be dispatched by database engine type
(:database_require_filter table)
(query-with-default-partitioned-field-filter (:id table)))) | |
(defn- field-query [{table-id :table_id} mbql-query]
{:pre [(integer? table-id)]}
(let [table (t2/select-one :model/Table :id table-id)]
(qp-query (:db_id table)
(field-mbql-query table mbql-query)))) | |
The absolute maximum number of results to return for a Of course, if a User does something crazy, like mark a million-arity Field as List, we don't want Metabase to explode trying to make their dreams a reality; we need some sort of hard limit to prevent catastrophes. So this limit is effectively a safety to prevent Users from nuking their own instance for Fields that really shouldn't be List Fields at all. For these very-high-cardinality Fields, we're effectively capping the number of FieldValues that get could saved. This number should be a balance of:
| (def ^Integer absolute-max-distinct-values-limit (int 1000)) |
(mu/defn field-distinct-values :- [:sequential ms/NonRemappedFieldValue]
"Return the distinct values of `field`, each wrapped in a vector.
This is used to create a `FieldValues` object for `:type/Category` Fields."
([field]
(field-distinct-values field absolute-max-distinct-values-limit))
([field max-results :- ms/PositiveInt]
(field-query field {:breakout [[:field (u/the-id field) nil]]
:limit (min max-results absolute-max-distinct-values-limit)}))) | |
Return the distinct count of | (defn field-distinct-count
[field & [limit]]
(-> (field-query field {:aggregation [[:distinct [:field (u/the-id field) nil]]]
:limit limit})
first first int)) |
Return the count of | (defn field-count
[field]
(-> (field-query field {:aggregation [[:count [:field (u/the-id field) nil]]]})
first first int)) |
The maximum number of values we should return when using | (def max-sample-rows 10000) |
Number of rows to sample for tables with nested (e.g., JSON) columns. | (def nested-field-sample-limit 500) |
Schema for | (def ^:private TableRowsSampleOptions
[:maybe
[:map
[:truncation-size {:optional true} :int]
[:limit {:optional true} :int]
[:order-by {:optional true} (helpers/distinct (helpers/non-empty [:sequential mbql.s/OrderBy]))]
[:rff {:optional true} fn?]]]) |
Identify text fields which can accept our substring optimization. JSON and XML fields are now marked as | (defn- text-field?
[{:keys [base_type semantic_type]}]
(and (= base_type :type/Text)
(not (isa? semantic_type :type/Structured)))) |
Returns the mbql query to query a table for sample rows | (defn- table-rows-sample-query
[table
fields
{:keys [truncation-size limit order-by] :or {limit max-sample-rows} :as _opts}]
(let [database (table/database table)
driver (driver.u/database->driver database)
text-fields (filter text-field? fields)
field->expressions (when (and truncation-size (driver/database-supports? driver :expressions database))
(into {} (for [field text-fields]
[field [(str (gensym "substring"))
[:substring [:field (u/the-id field) nil]
1 truncation-size]]])))]
{:database (:db_id table)
:type :query
:query (cond-> {:source-table (u/the-id table)
:expressions (into {} (vals field->expressions))
:fields (vec (for [field fields]
(if-let [[expression-name _] (get field->expressions field)]
[:expression expression-name]
[:field (u/the-id field) nil])))
:limit limit}
order-by
(assoc :order-by order-by)
(:database_require_filter table)
(query-with-default-partitioned-field-filter (:id table)))
:middleware {:format-rows? false
:skip-results-metadata? true}})) |
Run a basic MBQL query to fetch a sample of rows of FIELDS belonging to a TABLE. Options: a map of
| (mu/defn table-rows-sample
{:style/indent 1}
([table :- (ms/InstanceOf :model/Table)
fields :- [:sequential (ms/InstanceOf :model/Field)]
rff]
(table-rows-sample table fields rff nil))
([table :- (ms/InstanceOf :model/Table)
fields :- [:sequential (ms/InstanceOf :model/Field)]
rff :- fn?
opts :- TableRowsSampleOptions]
(let [query (table-rows-sample-query table fields opts)]
(qp/process-query query rff nil)))) |
(defmethod driver/table-rows-sample :default [_driver table fields rff opts] (table-rows-sample table fields rff opts)) | |
Honey SQL 2 replacements for [[toucan.db/query]] and [[toucan.db/reducible-query]]. These are here to ease our transition to Honey SQL 2 and Toucan 2. Once we switch over to the latter we can hopefully remove this namespace. PRO TIPS:
| (ns metabase.db.query (:refer-clojure :exclude [compile]) (:require [clojure.string :as str] [honey.sql :as sql] [metabase.db.connection :as mdb.connection] [metabase.driver :as driver] [metabase.plugins.classloader :as classloader] [metabase.util.log :as log] [toucan2.core :as t2] [toucan2.jdbc.options :as t2.jdbc.options])) |
(set! *warn-on-reflection* true) | |
Return a nicely-formatted version of a | (defn format-sql [sql] (driver/prettify-native-form (mdb.connection/db-type) sql)) |
Compile a | (defmulti compile
{:arglists '([query])}
type) |
(defmethod compile String [sql] (compile [sql])) | |
(defmethod compile clojure.lang.IPersistentVector [sql-args] sql-args) | |
(defmethod compile clojure.lang.IPersistentMap
[honey-sql]
;; make sure metabase.db.setup is loaded so the `:metabase.db.setup/application-db` gets defined
(classloader/require 'metabase.db.setup)
(let [sql-args (try
(sql/format honey-sql {:quoted true, :dialect :metabase.db.setup/application-db, :quoted-snake false})
(catch Throwable e
;; this is not i18n'ed because it (hopefully) shouldn't be user-facing -- we shouldn't be running
;; in to unexpected Honey SQL compilation errors at run time -- if we are it means we're not being
;; careful enough with the Honey SQL forms we create which is a bug in the Metabase code we should
;; have caught in tests.
(throw (ex-info (str "Error compiling Honey SQL: " (ex-message e))
{:honey-sql honey-sql}
e))))]
(log/tracef "Compiled SQL:\n%s\nparameters: %s"
(format-sql (first sql-args))
(pr-str (rest sql-args)))
sql-args)) | |
Replacement for [[toucan.db/query]] -- uses Honey SQL 2 instead of Honey SQL 1, to ease the transition to the former (and to Toucan 2). Query the application database and return all results at once. See namespace documentation for [[metabase.db.query]] for pro debugging tips. TODO -- we should mark this deprecated and tell people to use [[toucan2.core/query]] directly instead | (defn query
[sql-args-or-honey-sql-map & {:as jdbc-options}]
;; make sure [[metabase.db.setup]] gets loaded so default Honey SQL options and the like are loaded.
(classloader/require 'metabase.db.setup)
(let [sql-args (compile sql-args-or-honey-sql-map)]
;; catch errors running the query and rethrow with the failing generated SQL and the failing Honey SQL form -- this
;; will help with debugging stuff. This should mostly be dev-facing because we should hopefully not be committing
;; any busted code into the repo
(try
(binding [t2.jdbc.options/*options* (merge t2.jdbc.options/*options* jdbc-options)]
(t2/query sql-args))
(catch Throwable e
(let [formatted-sql (format-sql (first sql-args))]
(throw (ex-info (str "Error executing SQL query: " (ex-message e)
\newline
\newline
formatted-sql)
{:sql (str/split-lines (str/trim formatted-sql))
:args (rest sql-args)
:uncompiled sql-args-or-honey-sql-map}
e))))))) |
Replacement for [[toucan.db/reducible-query]] -- uses Honey SQL 2 instead of Honey SQL 1, to ease the transition to the former (and to Toucan 2). Query the application database and return an See namespace documentation for [[metabase.db.query]] for pro debugging tips. | (defn reducible-query
[sql-args-or-honey-sql-map & {:as jdbc-options}]
;; make sure [[metabase.db.setup]] gets loaded so default Honey SQL options and the like are loaded.
(classloader/require 'metabase.db.setup)
(let [sql-args (compile sql-args-or-honey-sql-map)]
;; It doesn't really make sense to put a try-catch around this since it will return immediately and not execute
;; until we actually reduce it
(reify clojure.lang.IReduceInit
(reduce [_this rf init]
(binding [t2.jdbc.options/*options* (merge t2.jdbc.options/*options* jdbc-options)]
(reduce rf init (t2/reducible-query sql-args))))))) |
Code for setting up the application DB -- verifying that we can connect and for running migrations. Unlike code in
Because functions here don't know where the JDBC spec came from, you can use them to perform the usual application
DB setup steps on arbitrary databases -- useful for functionality like the | (ns metabase.db.setup (:require [honey.sql :as sql] [metabase.db.connection :as mdb.connection] [metabase.db.custom-migrations] [metabase.db.jdbc-protocols :as mdb.jdbc-protocols] [metabase.db.liquibase :as liquibase] [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn] [metabase.models.setting :as setting] [metabase.plugins.classloader :as classloader] [metabase.util :as u] [metabase.util.honey-sql-2] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [methodical.core :as methodical] [toucan2.honeysql2 :as t2.honeysql] [toucan2.jdbc.options :as t2.jdbc.options] [toucan2.pipeline :as t2.pipeline]) (:import (liquibase.exception LockException))) |
(set! *warn-on-reflection* true) | |
(comment ;; load our custom migrations metabase.db.custom-migrations/keep-me ;; needed so the `:h2` dialect gets registered with Honey SQL metabase.util.honey-sql-2/keep-me) | |
If we are not doing auto migrations then print out migration SQL for user to run manually. Then throw an exception to short circuit the setup process and make it clear we can't proceed. | (defn- print-migrations-and-quit-if-needed!
[liquibase]
(when (seq (liquibase/unrun-migrations liquibase))
(log/info (str (trs "Database Upgrade Required")
"\n\n"
(trs "NOTICE: Your database requires updates to work with this version of Metabase.")
"\n"
(trs "Please execute the following sql commands on your database before proceeding.")
"\n\n"
(liquibase/migrations-sql liquibase)
"\n\n"
(trs "Once your database is updated try running the application again.")
"\n"))
(throw (Exception. (trs "Database requires manual upgrade."))))) |
Migrate the application database specified by
| (mu/defn migrate!
[db-type :- :keyword
data-source :- (ms/InstanceOfClass javax.sql.DataSource)
direction :- :keyword
& args]
;; TODO: use [[jdbc/with-db-transaction]] instead of manually commit/rollback
(with-open [conn (.getConnection ^javax.sql.DataSource data-source)]
(.setAutoCommit conn false)
;; Set up liquibase and let it do its thing
(log/info (trs "Setting up Liquibase..."))
(liquibase/with-liquibase [liquibase conn]
(try
(liquibase/consolidate-liquibase-changesets! conn)
(log/info (trs "Liquibase is ready."))
(case direction
:up (liquibase/migrate-up-if-needed! liquibase)
:force (liquibase/force-migrate-up-if-needed! liquibase)
:down (apply liquibase/rollback-major-version db-type conn liquibase args)
:print (print-migrations-and-quit-if-needed! liquibase)
:release-locks (liquibase/force-release-locks! liquibase))
;; Migrations were successful; commit everything and re-enable auto-commit
(.commit conn)
(.setAutoCommit conn true)
:done
;; In the Throwable block, we're releasing the lock assuming we have the lock and we failed while in the
;; middle of a migration. It's possible that we failed because we couldn't get the lock. We don't want to
;; clear the lock in that case, so handle that case separately
(catch LockException e
(.rollback conn)
(throw e))
;; If for any reason any part of the migrations fail then rollback all changes
(catch Throwable e
(.rollback conn)
;; With some failures, it's possible that the lock won't be released. To make this worse, if we retry the
;; operation without releasing the lock first, the real error will get hidden behind a lock error
(liquibase/release-lock-if-needed! liquibase)
(throw e)))))) |
Test connection to application database with | (mu/defn ^:private verify-db-connection
[db-type :- :keyword
data-source :- (ms/InstanceOfClass javax.sql.DataSource)]
(log/info (u/format-color 'cyan (trs "Verifying {0} Database Connection ..." (name db-type))))
(classloader/require 'metabase.driver.util)
(let [error-msg (trs "Unable to connect to Metabase {0} DB." (name db-type))]
(try (assert (sql-jdbc.conn/can-connect-with-spec? {:datasource data-source}) error-msg)
(catch Throwable e
(throw (ex-info error-msg {} e)))))
(with-open [conn (.getConnection ^javax.sql.DataSource data-source)]
(let [metadata (.getMetaData conn)]
(log/info (trs "Successfully verified {0} {1} application database connection."
(.getDatabaseProductName metadata) (.getDatabaseProductVersion metadata))
(u/emoji "✅"))))) |
(mu/defn ^:private error-if-downgrade-required!
[data-source :- (ms/InstanceOfClass javax.sql.DataSource)]
(log/info (u/format-color 'cyan (trs "Checking if a database downgrade is required...")))
(with-open [conn (.getConnection ^javax.sql.DataSource data-source)]
(liquibase/with-liquibase [liquibase conn]
(let [latest-available (liquibase/latest-available-major-version liquibase)
latest-applied (liquibase/latest-applied-major-version conn)]
;; `latest-applied` will be `nil` for fresh installs
(when (and latest-applied (< latest-available latest-applied))
(log/error (str (u/format-color 'red (trs "ERROR: Downgrade detected."))
"\n\n"
(trs "Your metabase instance appears to have been downgraded without a corresponding database downgrade.")
"\n\n"
(trs "You must run `java -jar metabase.jar migrate down` from version {0}." latest-applied)
"\n\n"
(trs "Once your database has been downgraded, try running the application again.")
"\n\n"
(trs "See: https://www.metabase.com/docs/latest/installation-and-operation/upgrading-metabase#rolling-back-an-upgrade")))
(throw (ex-info (trs "Downgrade detected. Please run `migrate down` from version {0}."
latest-applied)
{}))))))) | |
Run through our DB migration process and make sure DB is fully prepared | (mu/defn ^:private run-schema-migrations! [db-type :- :keyword data-source :- (ms/InstanceOfClass javax.sql.DataSource) auto-migrate? :- [:maybe :boolean]] (log/info (trs "Running Database Migrations...")) (migrate! db-type data-source (if auto-migrate? :up :print)) (log/info (trs "Database Migrations Current ... ") (u/emoji "✅"))) |
Connects to db and runs migrations. Don't use this directly, unless you know what you're doing; use [[metabase.db/setup-db!]] instead, which can be called more than once without issue and is thread-safe. TODO -- consider renaming to something like TODO -- consider whether this should be done automatically the first time someone calls | (mu/defn setup-db!
[db-type :- :keyword
data-source :- (ms/InstanceOfClass javax.sql.DataSource)
auto-migrate? :- [:maybe :boolean]]
(u/profile (trs "Database setup")
(u/with-us-locale
(binding [mdb.connection/*application-db* (mdb.connection/application-db db-type data-source :create-pool? false) ; should already be a pool
setting/*disable-cache* true]
(verify-db-connection db-type data-source)
(error-if-downgrade-required! data-source)
(run-schema-migrations! db-type data-source auto-migrate?))))
:done) |
Toucan Setup. | |
Done at namespace load time these days. | |
Quote SQL identifier string create a custom HoneySQL quoting style called | (defn quote-for-application-db
([s]
(quote-for-application-db (mdb.connection/quoting-style (mdb.connection/db-type)) s))
([dialect s]
{:pre [(#{:h2 :ansi :mysql} dialect)]}
((:quote (sql/get-dialect dialect)) s))) |
register with Honey SQL 2 | (sql/register-dialect!
::application-db
(assoc (sql/get-dialect :ansi)
:quote quote-for-application-db)) |
(reset! t2.honeysql/global-options
{:quoted true
:dialect ::application-db
:quoted-snake false}) | |
(reset! t2.jdbc.options/global-options
{:read-columns mdb.jdbc-protocols/read-columns
:label-fn u/lower-case-en}) | |
(methodical/defmethod t2.pipeline/build :around :default
"Normally, our Honey SQL 2 `:dialect` is set to `::application-db`; however, Toucan 2 does need to know the actual
dialect to do special query building magic. When building a Honey SQL form, make sure `:dialect` is bound to the
*actual* dialect for the application database."
[query-type model parsed-args resolved-query]
(binding [t2.honeysql/*options* (assoc t2.honeysql/*options*
:dialect (mdb.connection/quoting-style (mdb.connection/db-type)))]
(next-method query-type model parsed-args resolved-query))) | |
Functions for creating JDBC DB specs for a given driver. Only databases that are supported as application DBs should have functions in this namespace; otherwise, similar functions are only needed by drivers, and belong in those namespaces. | (ns metabase.db.spec (:require [clojure.string :as str] [metabase.config :as config])) |
Create a [[clojure.java.jdbc]] spec map from broken-out database | (defmulti spec
{:arglists '([db-type details])}
(fn [db-type _details]
(keyword db-type))) |
(defmethod spec :h2
[_ {:keys [db]
:or {db "h2.db"}
:as opts}]
(merge {:classname "org.h2.Driver"
:subprotocol "h2"
:subname db}
(dissoc opts :db))) | |
Make a subname for the given | (defn make-subname
{:arglists '([host port db]), :added "0.39.0"}
[host port db]
(str "//" (when-not (str/blank? host) (str host ":" port)) (if-not (str/blank? db) (str "/" db) "/"))) |
(defmethod spec :postgres
[_ {:keys [host port db]
:or {host "localhost", port 5432, db ""}
:as opts}]
(merge
{:classname "org.postgresql.Driver"
:subprotocol "postgresql"
:subname (make-subname host (or port 5432) db)
;; I think this is done to prevent conflicts with redshift driver registering itself to handle postgres://
:OpenSourceSubProtocolOverride true
:ApplicationName config/mb-version-and-process-identifier}
(dissoc opts :host :port :db))) | |
(defmethod spec :mysql
[_ {:keys [host port db]
:or {host "localhost", port 3306, db ""}
:as opts}]
(merge
{:classname "org.mariadb.jdbc.Driver"
:subprotocol "mysql"
:subname (make-subname host (or port 3306) db)}
(dissoc opts :host :port :db))) | |
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! !! !! Don't put database spec functions for new drivers in this namespace. These ones are only here because they !! !! can also be used for the application DB in metabase.driver. Put functions like these for new drivers in the !! !! driver namespace itself. !! !! !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! | |
Functions for updating an H2 v1.x database to v2.x | (ns metabase.db.update-h2 (:require [clj-http.client :as http] [clojure.java.io :as io] [clojure.java.jdbc :as jdbc] [clojure.java.shell :as sh] [clojure.string :as str] [metabase.util.files :as u.files] [metabase.util.log :as log]) (:import (java.nio.file Files))) |
(set! *warn-on-reflection* true) | |
Generic utils | |
Returns seq of first n bytes of file at path | (defn- head
[path n]
(let [f (io/file path)
bytes (byte-array n)]
(with-open [input (io/input-stream f)]
(take (.read input bytes) bytes)))) |
Tries to parse and return x as char, else nil | (defn- try-char [x] (try (char x) (catch IllegalArgumentException _ nil))) |
H2-specific utils | |
Returns H2 database base path from JDBC URL, i.e. without .mv.db | (defn- h2-base-path [jdbc-url] (second (re-matches #"jdbc:h2:file:(.*)$" jdbc-url))) |
Returns the H2 major version number of H2 MV database file at path, or nil if no file exists | (defn db-version
[jdbc-url]
;; The H2 database version is indicated in the "format:" key of the MV file header, which is 4096 bytes
;; See: https://www.h2database.com/html/mvstore.html
(when-let [path (str (h2-base-path jdbc-url) ".mv.db")]
(when (.exists (io/file path))
(let [header (str/join (map try-char (head path 4096)))
format-key "format:"]
(when-not (.startsWith header "H:2")
(throw (IllegalArgumentException. "File does not appear to be an H2 MV database file")))
(Integer/parseInt (str (nth header (+ (.indexOf header format-key) (count format-key))))))))) |
Migration constants/utils | |
(def ^:private v1-jar-url "https://repo1.maven.org/maven2/com/h2database/h2/1.4.197/h2-1.4.197.jar") | |
(defn- tmp-path [& components] (str (apply u.files/get-path (System/getProperty "java.io.tmpdir") components))) | |
(def ^:private jar-path (tmp-path (last (.split ^String v1-jar-url "/")))) | |
(def ^:private migration-sql-path (tmp-path "metabase-migrate-h2-db-v1-v2.sql")) | |
Migration logic | |
Updates existing H2 v1 database to H2 v2 | (defn- update!
[jdbc-url]
(when-not (.exists (io/file jar-path))
(log/info "Downloading" v1-jar-url)
(io/copy (:body (http/get v1-jar-url {:as :stream})) (io/file jar-path)))
(log/info "Creating v1 database backup at" migration-sql-path)
(let [result (sh/sh "java" "-cp" jar-path "org.h2.tools.Script" "-url" jdbc-url "-script" migration-sql-path)]
(when-not (= 0 (:exit result))
(throw (ex-info "Dumping H2 database failed." {:result result}))))
(let [base-path (h2-base-path jdbc-url)
backup-path (str base-path ".v1-backup.mv.db")]
(log/info "Moving old app database to" backup-path)
(Files/move (u.files/get-path (str base-path ".mv.db"))
(u.files/get-path backup-path)
(into-array java.nio.file.CopyOption [])))
(log/info "Restoring backup into v2 database")
(jdbc/execute! {:connection-uri jdbc-url} ["RUNSCRIPT FROM ? FROM_1X" migration-sql-path])
(log/info "Backup restored into H2 v2 database. Update complete!")) |
(def ^:private h2-lock (Object.)) | |
Updates H2 database at db-path from version 1.x to 2.x if jdbc-url points to version 1 H2 database. | (defn update-if-needed!
[jdbc-url]
(locking h2-lock
(when (= 1 (db-version jdbc-url))
(log/info "H2 v1 database detected, updating...")
(try
(update! jdbc-url)
(catch Exception e
(log/error "Failed to update H2 database:" e)
(throw e)))))) |
Utility functions for querying the application database. | (ns metabase.db.util (:require [metabase.util :as u] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2] [toucan2.model :as t2.model])) |
Check if | (defn toucan-model? [model] (isa? model :metabase/model)) |
Returns a qualified field for [modelable] with [field-name]. | (defn qualify
^clojure.lang.Keyword [modelable field-name]
(if (vector? field-name)
[(qualify modelable (first field-name)) (second field-name)]
(let [model (t2.model/resolve-model modelable)]
(keyword (str (name (t2.model/table-name model)) \. (name field-name)))))) |
Convenience for generating a HoneySQL (t2/select-pks-set FieldValues (mdb/join [FieldValues :field_id] [Field :id]) :active true) | (defn join
[[source-entity fk] [dest-entity pk]]
{:left-join [(t2/table-name (t2.model/resolve-model dest-entity))
[:= (qualify source-entity fk) (qualify dest-entity pk)]]}) |
(def ^:private NamespacedKeyword [:and :keyword [:fn (comp seq namespace)]]) | |
(mu/defn ^:private type-keyword->descendants :- [:set {:min 1} ms/NonBlankString]
"Return a set of descendents of Metabase `type-keyword`. This includes `type-keyword` itself, so the set will always
have at least one element.
(type-keyword->descendants :Semantic/Coordinate) ; -> #{\"type/Latitude\" \"type/Longitude\" \"type/Coordinate\"}"
[type-keyword :- NamespacedKeyword]
(set (map u/qualified-name (cons type-keyword (descendants type-keyword))))) | |
Convenience for generating an HoneySQL (t2/select Field :semantic_type (mdb/isa :type/URL)) -> (t2/select Field :semantic_type [:in #{"type/URL" "type/ImageURL" "type/AvatarURL"}]) Also accepts optional (t2/select Field {:where (mdb/isa :semantic_type :type/URL)}) -> (t2/select Field {:where [:in :semantic_type #{"type/URL" "type/ImageURL" "type/AvatarURL"}]}) | (defn isa
([type-keyword]
[:in (type-keyword->descendants type-keyword)])
;; when using this with an `expr` (e.g. `(isa :semantic_type :type/URL)`) just go ahead and take the results of the
;; one-arity impl above and splice expr in as the second element
;;
;; [:in #{"type/URL" "type/ImageURL"}]
;;
;; becomes
;;
;; [:in :semantic_type #{"type/URL" "type/ImageURL"}]
([expr type-keyword]
[:in expr (type-keyword->descendants type-keyword)])) |
(ns metabase.domain-entities.converters
(:require
[malli.core :as mc]
[malli.transform :as mtx]
[metabase.util :as u])) | |
(defn- decode-map [schema _]
(let [by-prop (into {} (for [[map-key props] (mc/children schema)]
[(or (get props :js/prop)
(u/->snake_case_en (u/qualified-name map-key)))
{:map-key map-key}]))]
{:enter (fn [x]
(cond
(map? x) x
(object? x)
(into {} (for [prop (js-keys x)
:let [js-val (unchecked-get x prop)
map-key (or (get-in by-prop [prop :map-key])
(keyword (u/->kebab-case-en prop)))]]
[map-key js-val]))))
:leave (fn [x]
(if (object? x)
(throw (ex-info "decode-map leaving with a JS object not a CLJS map"
{:value x
:schema (mc/form schema)}))
x))})) | |
(defn- infer-child-decoder [schema _]
(let [mapping (into {} (for [c (mc/children schema)]
(if (keyword? c)
[(name c) c]
[c c])))]
{:enter #(mapping % %)})) | |
(defn- infer-child-encoder [schema _]
(let [mapping (into {} (for [c (mc/children schema)]
(if (keyword? c)
[c (name c)]
[c c])))]
{:enter #(mapping % %)})) | |
(defn- decode-map-of [keydec x]
(cond
(map? x) x
(object? x) (into {} (for [prop (js/Object.keys x)]
[(keydec prop) (unchecked-get x prop)])))) | |
(defn- encode-map [x keyenc]
(cond
(object? x) x
(map? x) (reduce-kv (fn [obj k v]
(unchecked-set obj (keyenc k) v)
obj)
#js {}
x))) | |
(def ^:private identity-transformers
(-> ['string? :string
'number? :number
'int? :int
'double? :double
'float? :float]
(zipmap (repeat {:enter identity})))) | |
Malli transformer for converting JavaScript data to and from CLJS data. This is a bit more flexible than a JSON transformer. In particular, it normalizes the keys of On keyword conversion Note that Observe that On Note that On sequences
| (def js-transformer
(mtx/transformer
{:name :js
:decoders
(merge identity-transformers
{:keyword keyword
'keyword? keyword
:qualified-keyword keyword
:uuid parse-uuid
:vector {:enter #(and % (vec %))}
:sequential {:enter #(and % (vec %))}
:tuple {:enter #(and % (vec %))}
:cat {:enter #(and % (vec %))}
:catn {:enter #(and % (vec %))}
:enum {:compile infer-child-decoder}
:= {:compile infer-child-decoder}
:map {:compile decode-map}
:map-of {:compile (fn [schema _]
(let [[key-schema] (mc/children schema)
keydec (mc/decoder key-schema js-transformer)]
{:enter #(decode-map-of keydec %)}))}})
:encoders
(merge identity-transformers
{:keyword name
'keyword? name
:qualified-keyword #(str (namespace %) "/" (name %))
:uuid str
:vector {:leave clj->js}
:sequential {:leave clj->js}
:tuple {:leave clj->js}
:enum {:compile infer-child-encoder}
:= {:compile infer-child-encoder}
:map {:compile
(fn [schema _]
(let [js-props (into {} (for [[k props] (mc/children schema)
:when (:js/prop props)]
[k (:js/prop props)]))
keyenc (fn [k] (or (get js-props k)
(u/->snake_case_en (u/qualified-name k))))]
{:leave #(encode-map % keyenc)}))}
:map-of {:leave #(encode-map % name)}})})) |
Returns a function for converting a JS value into CLJS data structures, based on a schema. | (defn incoming [schema] ;; TODO This should be a mc/coercer that decodes and then validates, throwing if it doesn't match. ;; However, enabling that now breaks loads of tests that pass input data with lots of holes. The JS ;; tests (as opposed to TS) are particularly bad for this. ;; Don't forget the nested `mc/decoder` calls elsewhere in this file! (mc/decoder schema js-transformer)) |
Returns a function for converting a CLJS value back into a plain JS one, based on its schema. | (defn outgoing [schema] (mc/encoder schema js-transformer)) |
(ns metabase.domain-entities.core (:require [clojure.string :as str] [medley.core :as m] [metabase.domain-entities.specs :refer [domain-entity-specs MBQL]] [metabase.mbql.util :as mbql.u] [metabase.models.card :refer [Card]] [metabase.models.interface :as mi] [metabase.models.table :as table :refer [Table]] [metabase.util :as u] [schema.core :as s])) | |
Return the most specific type of a given field. | (def ^:private ^{:arglists '([field])} field-type
(some-fn :semantic_type :base_type)) |
A reference to a | (def SourceName s/Str) |
(def ^:private DimensionReference s/Str) | |
Mapping from dimension name to the corresponding instantiated MBQL snippet | (def DimensionBindings
{DimensionReference MBQL}) |
A source for a card. Can be either a table or another card. | (def SourceEntity
#_{:clj-kondo/ignore [:deprecated-var]}
(s/cond-pre (mi/InstanceOf:Schema Table) (mi/InstanceOf:Schema Card))) |
Top-level lexical context mapping source names to their corresponding entity and constituent dimensions. See also
| (def Bindings
{SourceName {(s/optional-key :entity) SourceEntity
(s/required-key :dimensions) DimensionBindings}}) |
(s/defn ^:private get-dimension-binding :- MBQL
[bindings :- Bindings, source :- SourceName, dimension-reference :- DimensionReference]
(let [[table-or-dimension maybe-dimension] (str/split dimension-reference #"\.")]
(if maybe-dimension
(let [field-clause (get-in bindings [table-or-dimension :dimensions maybe-dimension])]
(cond-> field-clause
(not= source table-or-dimension) (mbql.u/assoc-field-options :join-alias table-or-dimension)))
(get-in bindings [source :dimensions table-or-dimension])))) | |
Instantiate all dimension reference in given (nested) structure | (s/defn resolve-dimension-clauses
[bindings :- Bindings, source :- SourceName, obj]
(mbql.u/replace obj
[:dimension dimension] (->> dimension
(get-dimension-binding bindings source)
(resolve-dimension-clauses bindings source)))) |
(s/defn mbql-reference :- MBQL
"Return MBQL clause for a given field-like object."
[{:keys [id name base_type]}]
(if id
[:field id nil]
[:field name {:base-type base_type}])) | |
(defn- has-attribute?
[entity {:keys [field _domain_entity _has_many]}]
(cond
field (some (fn [col]
(when (or (isa? (field-type col) field)
(= (:name col) (name field)))
col))
((some-fn :fields :result_metadata) entity)))) | |
Does source entity satisfies requierments of given spec? | (defn satisfies-requierments?
[entity {:keys [required_attributes]}]
(every? (partial has-attribute? entity) required_attributes)) |
(defn- best-match
[candidates]
(->> candidates
(sort-by (juxt (comp count ancestors :type) (comp count :required_attributes)))
last)) | |
(defn- instantiate-dimensions
[bindings source entities]
(into (empty entities) ; this way we don't care if we're dealing with a map or a vec
(for [entity entities
:when (every? (get-in bindings [source :dimensions])
(mbql.u/match entity [:dimension dimension] dimension))]
(resolve-dimension-clauses bindings source entity)))) | |
(defn- instantiate-domain-entity
[table {:keys [name description metrics segments breakout_dimensions type]}]
(let [dimensions (into {} (for [field (:fields table)]
[(-> field field-type clojure.core/name) field]))
bindings {name {:entity table
:dimensions (m/map-vals mbql-reference dimensions)}}]
{:metrics (instantiate-dimensions bindings name metrics)
:segments (instantiate-dimensions bindings name segments)
:breakout_dimensions (instantiate-dimensions bindings name breakout_dimensions)
:dimensions dimensions
:type type
:description description
:source_table (u/the-id table)
:name name})) | |
Find the best fitting domain entity for given table. | (defn domain-entity-for-table
[table]
(let [table (assoc table :fields (table/fields table))]
(some->> @domain-entity-specs
vals
(filter (partial satisfies-requierments? table))
best-match
(instantiate-domain-entity table)))) |
Fake hydration function. | (defn with-domain-entity
[tables]
(for [table tables]
(assoc table :domain_entity (domain-entity-for-table table)))) |
(ns metabase.domain-entities.malli
(:require
[malli.core :as mc]
[malli.util :as mut]
[metabase.domain-entities.converters])
(:require-macros [metabase.domain-entities.malli])) | |
Given a schema and a value path (as opposed to a schema path), finds the schema for that path. Throws if there are multiple such paths and those paths have different schemas. | (clojure.core/defn schema-for-path
[schema path]
(let [paths (-> schema mc/schema (mut/in->paths path))]
(cond
(empty? paths) (throw (ex-info "Path does not match schema" {:schema schema :path path}))
(= (count paths) 1) (mut/get-in schema (first paths))
:else (let [child-schemas (map #(mut/get-in schema %) paths)]
(if (apply = child-schemas)
(first child-schemas)
(throw (ex-info "Value path has multiple schema paths, with different schemas"
{:schema schema
:paths paths
:child-schemas child-schemas}))))))) |
(ns metabase.domain-entities.malli
(:refer-clojure :exclude [defn])
(:require
[malli.instrument]
[net.cgrand.macrovich :as macros])) | |
Generates an accessor, given the symbol and path to the value. | (defmacro -define-getter
[sym path]
`(clojure.core/defn ~(vary-meta sym assoc :export true)
~(str "Accessor for `" path "`.")
[obj#]
(get-in obj# ~path))) |
Incoming converter for the replacement value. | (defmacro -define-converter
[schema path in-sym]
`(def ~in-sym
~(macros/case
:cljs `(-> ~schema
(metabase.domain-entities.malli/schema-for-path ~path)
metabase.domain-entities.converters/incoming)
:clj `identity))) |
Generates a setter. Prefixes the symbol with | (defmacro -define-setter
[sym path in-sym]
`(clojure.core/defn ~(vary-meta (symbol (str "with-" (name sym)))
assoc :export true)
~(str "Updater for `" path "`.")
[obj# new-value#]
(assoc-in obj# ~path (~in-sym new-value#)))) |
Generates the outgoing converter from CLJS data structures to vanilla JS objects. Generates nothing in CLJ mode. | (defmacro -define-js-converter
[schema path out-sym]
(macros/case
:cljs `(def ~out-sym
(metabase.domain-entities.converters/outgoing
(metabase.domain-entities.malli/schema-for-path ~schema ~path))))) |
Generates a getter that converts back to a JS object, in CLJS.
Generates nothing in CLJ.
| (defmacro -define-js-returning-getter
[sym path out-sym]
(macros/case
:cljs `(clojure.core/defn ~(vary-meta (symbol (str (name sym) "-js"))
assoc :export true)
~(str "Fetches `" path "` and converts it to plain JS.")
[obj#]
(~out-sym (~sym obj#))))) |
Generates the getter, setter and necessary JS<->CLJS converters for a single In CLJ, this generates the getter, setter and a dummy incoming converter that is just In CLJS, generates the getter and setter, real converters in both directions, and a getter that returns vanilla JS objects instead of CLJS data. | (defmacro -define-getter-and-setter
[schema sym path]
(let [in-sym (vary-meta (symbol (str "->" (name sym)))
assoc :private true)
out-sym (vary-meta (symbol (str (name sym) "->"))
assoc :private true)]
`(do
(-define-getter ~sym ~path)
(-define-converter ~schema ~path ~in-sym)
(-define-setter ~sym ~path ~in-sym)
(-define-js-converter ~schema ~path ~out-sym)
(-define-js-returning-getter ~sym ~path ~out-sym)))) |
Generates an accessor ( For example: ``` (define-getters-and-setters Question dataset-query [:card :dataset-query] cache-ttl [:card :cache-ttl]) ``` will generate: ``` (mu/defn ^:export dataset-query :- DatasetQuery "Accessor for [:card :dataset-query]." [obj :- Question] (get-in obj [:card :dataset-query])) ;; This converter is always defined, but it's (mu/defn ^:export with-dataset-query :- Question "Updater for [:card :dataset-query]." [obj :- Question new-value :- DatasetQuery] (assoc-in obj [:card :dataset-query] (->dataset-query new-value))) ;; This converter is only generated in CLJS. (def ^:private dataset-query-> (converters/outgoing Question)) ;; This function is also only generated in CLJS.
(mu/defn ^:export dataset-query-js :- :any
"Fetches ;; ... and the same five things generated for cache-ttl and any other args. ``` You provide the schema for the parent object; the macro will examine that schema to determine the
schema for the field being fetched or updated. The updater's name gets prefixed with The converters are private and intended to be internal to the macros. Since they only depend on the schema it's more efficient to compute them once and reuse them. | (defmacro define-getters-and-setters
[schema sym path & more]
`(do
(-define-getter-and-setter ~schema ~sym ~path)
~(when (seq more)
`(define-getters-and-setters ~schema ~@more)))) |
(ns metabase.domain-entities.specs (:require [medley.core :as m] [metabase.mbql.normalize :as mbql.normalize] [metabase.mbql.util :as mbql.u] [metabase.util.yaml :as yaml] [schema.coerce :as sc] [schema.core :as s])) | |
MBQL clause (ie. a vector starting with a keyword) | (def MBQL (s/pred mbql.u/mbql-clause?)) |
Field type designator -- a keyword derived from | (def FieldType
(s/constrained s/Keyword
;#(isa? % :type/*)
identity)) |
(def ^:private DomainEntityReference s/Str) | |
(def ^:private DomainEntityType (s/isa :DomainEntity/*)) | |
(def ^:private Identifier s/Str) | |
(def ^:private Description s/Str) | |
(def ^:private Attributes [{(s/optional-key :field) FieldType
(s/optional-key :domain_entity) DomainEntityReference
(s/optional-key :has_many) {:domain_entity DomainEntityReference}}]) | |
(def ^:private BreakoutDimensions [MBQL]) | |
(def ^:private Metrics {Identifier {(s/required-key :aggregation) MBQL
(s/required-key :name) Identifier
(s/optional-key :breakout) BreakoutDimensions
(s/optional-key :filter) MBQL
(s/optional-key :description) Description}}) | |
(def ^:private Segments {Identifier {(s/required-key :filter) MBQL
(s/required-key :name) Identifier
(s/optional-key :description) Description}}) | |
Domain entity spec | (def DomainEntitySpec
{(s/required-key :name) DomainEntityReference
(s/required-key :type) DomainEntityType
(s/optional-key :description) Description
(s/required-key :required_attributes) Attributes
(s/optional-key :optional_attributes) Attributes
(s/optional-key :metrics) Metrics
(s/optional-key :segments) Segments
(s/optional-key :breakout_dimensions) BreakoutDimensions}) |
(defn- add-to-hiearchy!
[{:keys [name refines] :as spec}]
(let [spec-type (keyword "DomainEntity" name)
refines (some->> refines (keyword "DomainEntity"))]
(derive spec-type (or refines :DomainEntity/*))
(-> spec
(dissoc :refines)
(assoc :type spec-type)))) | |
(def ^:private ^{:arglists '([m])} add-name-from-key
(partial m/map-kv-vals (fn [k v]
(assoc v :name k)))) | |
(def ^:private domain-entity-spec-parser
(sc/coercer!
DomainEntitySpec
{MBQL mbql.normalize/normalize
Segments add-name-from-key
Metrics add-name-from-key
BreakoutDimensions (fn [breakout-dimensions]
(for [dimension breakout-dimensions]
(if (string? dimension)
(do
(s/validate FieldType (keyword "type" dimension))
[:dimension dimension])
dimension)))
FieldType (partial keyword "type")
;; Some map keys are names (ie. strings) while the rest are keywords, a distinction lost in YAML
s/Str name})) | |
(def ^:private domain-entities-dir "domain_entity_specs/") | |
List of registered domain entities. | (def domain-entity-specs
(delay (into {} (for [spec (yaml/load-dir domain-entities-dir (comp domain-entity-spec-parser
add-to-hiearchy!))]
[(:name spec) spec])))) |
Metabase Drivers handle various things we need to do with connected data warehouse databases, including things like introspecting their schemas and processing and running MBQL queries. Drivers must implement some or all of the multimethods defined below, and register themselves with a call to [[metabase.driver/register!]]. SQL-based drivers can use the | (ns metabase.driver (:require [clojure.set :as set] [clojure.string :as str] [java-time.api :as t] [metabase.driver.impl :as driver.impl] [metabase.models.setting :as setting :refer [defsetting]] [metabase.plugins.classloader :as classloader] [metabase.util :as u] [metabase.util.i18n :refer [deferred-tru trs tru]] [metabase.util.log :as log] [potemkin :as p] [toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
(declare notify-database-updated) | |
Send notification that all Databases should immediately release cached resources (i.e., connection pools). Currently only used below by [[report-timezone]] setter (i.e., only used when report timezone changes). Reusing
pooled connections with the old session timezone can have weird effects, especially if report timezone is changed to
| (defn- notify-all-databases-updated
[]
(doseq [{driver :engine, id :id, :as database} (t2/select 'Database)]
(try
(notify-database-updated driver database)
(catch Throwable e
(log/error e (trs "Failed to notify {0} Database {1} updated" driver id)))))) |
(defn- short-timezone-name [timezone-id]
(let [^java.time.ZoneId zone (if (seq timezone-id)
(t/zone-id timezone-id)
(t/zone-id))]
(.getDisplayName
zone
java.time.format.TextStyle/SHORT
(java.util.Locale/getDefault)))) | |
(defn- long-timezone-name [timezone-id]
(if (seq timezone-id)
timezone-id
(str (t/zone-id)))) | |
(defsetting report-timezone
(deferred-tru "Connection timezone to use when executing queries. Defaults to system timezone.")
:visibility :settings-manager
:export? true
:audit :getter
:setter
(fn [new-value]
(setting/set-value-of-type! :string :report-timezone new-value)
(notify-all-databases-updated))) | |
Current report timezone abbreviation | (defsetting report-timezone-short :visibility :public :export? true :setter :none :getter (fn [] (short-timezone-name (report-timezone))) :doc false) |
Current report timezone string | (defsetting report-timezone-long :visibility :public :export? true :setter :none :getter (fn [] (long-timezone-name (report-timezone))) :doc false) |
+----------------------------------------------------------------------------------------------------------------+ | Current Driver | +----------------------------------------------------------------------------------------------------------------+ | |
Current driver (a keyword such as | (def ^:dynamic *driver* nil) |
(declare the-driver) | |
Impl for | (defn do-with-driver
[driver f]
{:pre [(keyword? driver)]}
(binding [*driver* (the-driver driver)]
(f))) |
Bind current driver to (driver/with-driver :postgres ...) | (defmacro with-driver
{:style/indent 1}
[driver & body]
`(do-with-driver ~driver (fn [] ~@body))) |
+----------------------------------------------------------------------------------------------------------------+ | Driver Registration / Hierarchy / Multimethod Dispatch | +----------------------------------------------------------------------------------------------------------------+ | |
(p/import-vars [driver.impl hierarchy register! initialized?]) | |
(add-watch
#'hierarchy
nil
(fn [_ _ _ _]
(when (not= hierarchy driver.impl/hierarchy)
;; this is a dev-facing error so no need to i18n it.
(throw (Exception. (str "Don't alter #'metabase.driver/hierarchy directly, since it is imported from "
"metabase.driver.impl. Alter #'metabase.driver.impl/hierarchy instead if you need to "
"alter the var directly.")))))) | |
Is this driver available for use? (i.e. should we show it as an option when adding a new database?) This is Note that an available driver is not necessarily initialized yet; for example lazy-loaded drivers are registered
when Metabase starts up (meaning this will return | (defn available? [driver] ((every-pred driver.impl/registered? driver.impl/concrete?) driver)) |
Like [[clojure.core/the-ns]]. Converts argument to a keyword, then loads and registers the driver if not already done, throwing an Exception if it fails or is invalid. Returns keyword. Note that this does not neccessarily mean the driver is initialized (e.g., its full implementation and deps might not be loaded into memory) -- see also [[the-initialized-driver]]. This is useful in several cases: ;; Ensuring a driver is loaded & registered (isa? driver/hierarchy (the-driver :postgres) (the-driver :sql-jdbc) ;; Accepting either strings or keywords (e.g., in API endpoints) (the-driver "h2") ; -> :h2 ;; Ensuring a driver you are passed is valid (t2/insert! Database :engine (name (the-driver driver))) (the-driver :postgres) ; -> :postgres (the-driver :baby) ; -> Exception | (defn the-driver
[driver]
{:pre [((some-fn keyword? string?) driver)]}
(classloader/the-classloader)
(let [driver (keyword driver)]
(driver.impl/load-driver-namespace-if-needed! driver)
driver)) |
Add a new parent to | (defn add-parent!
[driver new-parent]
(when-not *compile-files*
(driver.impl/load-driver-namespace-if-needed! driver)
(driver.impl/load-driver-namespace-if-needed! new-parent)
(alter-var-root #'driver.impl/hierarchy derive driver new-parent))) |
Dispatch function to use for driver multimethods. Dispatches on first arg, a driver keyword; loads that driver's namespace if not already done. DOES NOT INITIALIZE THE DRIVER. Driver multimethods for abstract drivers like | (defn- dispatch-on-uninitialized-driver [driver & _] (the-driver driver)) |
(declare initialize!) | |
Like [[the-driver]], but also initializes the driver if not already initialized. | (defn the-initialized-driver
[driver]
(let [driver (the-driver driver)]
(driver.impl/initialize-if-needed! driver initialize!)
driver)) |
Like [[dispatch-on-uninitialized-driver]], but guarantees a driver is initialized before dispatch. Prefer [[the-driver]] for trivial methods that should do not require the driver to be initialized (e.g., ones that simply return information about the driver, but do not actually connect to any databases.) | (defn dispatch-on-initialized-driver [driver & _] (the-initialized-driver driver)) |
+----------------------------------------------------------------------------------------------------------------+ | Interface (Multimethod Defintions) | +----------------------------------------------------------------------------------------------------------------+ | |
Methods a driver can implement. Not all of these are required; some have default implementations immediately below them. SOME TIPS: To call the Clojure equivalent of the superclass implementation of a method, use (driver/register-driver! :my-driver, :parent :sql-jdbc) (defmethod driver/describe-table :my-driver [driver database table] (-> ((get-method driver/describe-table :sql-jdbc) driver databse table) (update :tables add-materialized-views))) Make sure to pass along the | |
DO NOT CALL THIS METHOD DIRECTLY. Called automatically once and only once the first time a non-trivial driver method is called; implementers should do one-time initialization as needed (for example, registering JDBC drivers used internally by the driver.) 'Trivial' methods include a tiny handful of ones like [[connection-properties]] that simply provide information about the driver, but do not connect to databases; these can be be supplied, for example, by a Metabase plugin manifest file (which is supplied for lazy-loaded drivers). Methods that require connecting to a database dispatch off of [[the-initialized-driver]], which will initialize a driver if not already done so. You will rarely need to write an implentation for this method yourself. A lazy-loaded driver (like most of the
Metabase drivers in v1.0 and above) are automatiaclly given an implentation of this method that performs the
If you do need to implement this method yourself, you do not need to call parent implementations. We'll take care of that for you. | (defmulti initialize!
{:added "0.32.0" :arglists '([driver])}
dispatch-on-uninitialized-driver) |
VERY IMPORTANT: Unlike all other driver multimethods, we DO NOT use the driver hierarchy for dispatch here. Why?
We do not want a driver to inherit parent drivers' implementations and have those implementations end up getting
called multiple times. If a driver does not implement
| |
(defmethod initialize! :default [_]) ; no-op | |
A nice name for the driver that we'll display to in the admin panel, e.g. "PostgreSQL" for When writing a driver that you plan to ship as a separate, lazy-loading plugin (including core drivers packaged this
way, like SQLite), you do not need to implement this method; instead, specifiy it in your plugin manifest, and
| (defmulti display-name
{:added "0.32.0" :arglists '([driver])}
dispatch-on-uninitialized-driver
:hierarchy #'hierarchy) |
(defmethod display-name :default [driver] (str/capitalize (name driver))) | |
The contact information for the driver | (defmulti contact-info
{:changelog-test/ignore true :added "0.43.0" :arglists '([driver])}
dispatch-on-uninitialized-driver
:hierarchy #'hierarchy) |
(defmethod contact-info :default [_] nil) | |
Dispatch on initialized driver, except checks for | (defn dispatch-on-initialized-driver-safe-keys
[driver details-map]
(let [invalid-keys #{"classname" "subprotocol" "connection-uri"}
ks (->> details-map keys
(map name)
(map u/lower-case-en) set)]
(when (seq (set/intersection ks invalid-keys))
(throw (ex-info "Cannot specify subname, protocol, or connection-uri in details map"
{:invalid-keys (set/intersection ks invalid-keys)})))
(dispatch-on-initialized-driver driver))) |
Check whether we can connect to a | (defmulti can-connect?
{:added "0.32.0" :arglists '([driver details])}
dispatch-on-initialized-driver-safe-keys
:hierarchy #'hierarchy) |
Return a map containing information that describes the version of the DBMS. This typically includes a
| (defmulti dbms-version
{:changelog-test/ignore true :added "0.46.0" :arglists '([driver database])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
Some drivers like BigQuery or Snowflake cannot provide a meaningful stable version. | (defmethod dbms-version :default [_ _] nil) |
Return a map containing information that describes all of the tables in a | (defmulti describe-database
{:added "0.32.0" :arglists '([driver database])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
Return a map containing information that describes the physical schema of | (defmulti describe-table
{:added "0.32.0" :arglists '([driver database table])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
Returns a set of map containing information about the indexes of a table. Currently we only sync single column indexes or the first column of a composite index. Results should match the [[metabase.sync.interface/TableIndexMetadata]] schema. | (defmulti describe-table-indexes
{:added "0.49.0" :arglists '([driver database table])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
escaping for when calling For example, oracle treats slashes differently when querying versus when used with | (defmulti escape-entity-name-for-metadata
{:arglists '([driver table-name]), :added "0.37.0"}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
(defmethod escape-entity-name-for-metadata :default [_driver table-name] table-name) | |
Return information about the foreign keys in a | (defmulti describe-table-fks
{:added "0.32.0" :arglists '([driver database table])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
(defmethod describe-table-fks ::driver [_ _ _] nil) | |
this is no longer used but we can leave it around for not for documentation purposes. Maybe we can actually do something useful with it like write a test that validates that drivers return correct connection details? | |
Return information about the connection properties that should be exposed to the user for databases that will use
this driver. This information is used to build the UI for editing a Database There are several definitions for common properties available in the [[metabase.driver.common]] namespace, such as
Like | #_(def ConnectionDetailsProperty
"Schema for a map containing information about a connection property we should ask the user to supply when setting up
a new database, as returned by an implementation of `connection-properties`."
(s/constrained
{
;; The key that should be used to store this property in the `details` map.
:name su/NonBlankString
;; Human-readable name that should be displayed to the User in UI for editing this field.
:display-name su/NonBlankString
;; Human-readable text that gives context about a field's input.
(s/optional-key :helper-text) s/Str
;; Type of this property. Defaults to `:string` if unspecified.
;; `:select` is a `String` in the backend.
(s/optional-key :type) (s/enum :string :integer :boolean :password :select :text)
;; A default value for this field if the user hasn't set an explicit value. This is shown in the UI as a
;; placeholder.
(s/optional-key :default) s/Any
;; Placeholder value to show in the UI if user hasn't set an explicit value. Similar to `:default`, but this value
;; is *not* saved to `:details` if no explicit value is set. Since `:default` values are also shown as
;; placeholders, you cannot specify both `:default` and `:placeholder`.
(s/optional-key :placeholder) s/Any
;; Is this property required? Defaults to `false`.
(s/optional-key :required?) s/Bool
;; Any options for `:select` types
(s/optional-key :options) {s/Keyword s/Str}}
(complement (every-pred #(contains? % :default) #(contains? % :placeholder)))
"connection details that does not have both default and placeholder"))
(defmulti connection-properties
{:added "0.32.0" :arglists '([driver])}
dispatch-on-uninitialized-driver
:hierarchy #'hierarchy) |
Execute a native query against that database and return rows that can be reduced using Pass metadata about the columns and the reducible object to (respond results-metadata rows) You can use [[metabase.query-processor.reducible/reducible-rows]] to create reducible, streaming results. Example impl: (defmethod reducible-query :my-driver [_ query context respond] (with-open [results (run-query! query)] (respond {:cols [{:name "my_col"}]} (qp.reducible/reducible-rows (get-row results) (context/canceled-chan context))))) | (defmulti execute-reducible-query
{:added "0.35.0", :arglists '([driver query context respond])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
Set of all features a driver can support. TODO -- I think we should rename this to | (def driver-features
#{
;; Does this database support foreign key relationships?
:foreign-keys
;; Does this database support nested fields for any and every field except primary key (e.g. Mongo)?
:nested-fields
;; Does this database support nested fields but only for certain field types (e.g. Postgres and JSON / JSONB columns)?
:nested-field-columns
;; Does this driver support setting a timezone for the query?
:set-timezone
;; Does the driver support *basic* aggregations like `:count` and `:sum`? (Currently, everything besides standard
;; deviation is considered \"basic\"; only GA doesn't support this).
;;
;; DEFAULTS TO TRUE.
:basic-aggregations
;; Does this driver support standard deviation and variance aggregations? Note that if variance is not supported
;; directly, you can calculate it manually by taking the square of the standard deviation. See the MongoDB driver
;; for example.
:standard-deviation-aggregations
;; Does this driver support expressions (e.g. adding the values of 2 columns together)?
:expressions
;; Does this driver support parameter substitution in native queries, where parameter expressions are replaced
;; with a single value? e.g.
;;
;; SELECT * FROM table WHERE field = {{param}}
;; ->
;; SELECT * FROM table WHERE field = 1
:native-parameters
;; Does the driver support using expressions inside aggregations? e.g. something like \"sum(x) + count(y)\" or
;; \"avg(x + y)\"
:expression-aggregations
;; Does the driver support using a query as the `:source-query` of another MBQL query? Examples are CTEs or
;; subselects in SQL queries.
:nested-queries
;; Does the driver support persisting models
:persist-models
;; Is persisting enabled?
:persist-models-enabled
;; Does the driver support binning as specified by the `binning-strategy` clause?
:binning
;; Does this driver not let you specify whether or not our string search filter clauses (`:contains`,
;; `:starts-with`, and `:ends-with`, collectively the equivalent of SQL `LIKE`) are case-senstive or not? This
;; informs whether we should present you with the 'Case Sensitive' checkbox in the UI. At the time of this writing
;; SQLite, SQLServer, and MySQL do not support this -- `LIKE` clauses are always case-insensitive.
;;
;; DEFAULTS TO TRUE.
:case-sensitivity-string-filter-options
:left-join
:right-join
:inner-join
:full-join
:regex
;; Does the driver support advanced math expressions such as log, power, ...
:advanced-math-expressions
;; Does the driver support percentile calculations (including median)
:percentile-aggregations
;; Does the driver support date extraction functions? (i.e get year component of a datetime column)
;; DEFAULTS TO TRUE
:temporal-extract
;; Does the driver support doing math with datetime? (i.e Adding 1 year to a datetime column)
;; DEFAULTS TO TRUE
:date-arithmetics
;; Does the driver support the :now function
:now
;; Does the driver support converting timezone?
;; DEFAULTS TO FALSE
:convert-timezone
;; Does the driver support :datetime-diff functions
:datetime-diff
;; Does the driver support experimental "writeback" actions like "delete this row" or "insert a new row" from 44+?
:actions
;; Does the driver support storing table privileges in the application database for the current user?
:table-privileges
;; Does the driver support uploading files
:uploads
;; Does the driver support schemas (aka namespaces) for tables
;; DEFAULTS TO TRUE
:schemas
;; Does the driver support custom writeback actions. Drivers that support this must
;; implement [[execute-write-query!]]
:actions/custom
;; Does changing the JVM timezone allow producing correct results? (See #27876 for details.)
:test/jvm-timezone-setting
;; Does the driver support connection impersonation (i.e. overriding the role used for individual queries)?
:connection-impersonation
;; Does the driver require specifying the default connection role for connection impersonation to work?
:connection-impersonation-requires-role
;; Does the driver require specifying a collection (table) for native queries? (mongo)
:native-requires-specified-collection
;; Does the driver support column(s) support storing index info
:index-info}) |
Does this driver support a certain (supports? :postgres :set-timezone) ; -> true DEPRECATED — [[database-supports?]] should be used instead. This function will be removed in Metabase version 0.50.0. | (defmulti supports?
{:added "0.32.0", :arglists '([driver feature]), :deprecated "0.47.0"}
(fn [driver feature]
(when-not (driver-features feature)
(throw (Exception. (tru "Invalid driver feature: {0}" feature))))
[(dispatch-on-initialized-driver driver) feature])
:hierarchy #'hierarchy) |
(defmethod supports? :default [_ _] false) | |
(defmethod supports? [::driver :schemas] [_ _] true) | |
Does this driver and specific instance of a database support a certain Database is guaranteed to be a Database instance. Most drivers can always return true or always return false for a given feature (e.g., :left-join is not supported by any version of Mongo DB). In some cases, a feature may only be supported by certain versions of the database engine.
In this case, after implementing (database-supports? :mongo :set-timezone mongo-db) ; -> true | (defmulti database-supports?
{:arglists '([driver feature database]), :added "0.41.0"}
(fn [driver feature _database]
(when-not (driver-features feature)
(throw (Exception. (tru "Invalid driver feature: {0}" feature))))
[(dispatch-on-initialized-driver driver) feature])
:hierarchy #'hierarchy) |
(defmethod database-supports? :default [driver feature _] (supports? driver feature)) | |
(doseq [[feature supported?] {:basic-aggregations true
:case-sensitivity-string-filter-options true
:date-arithmetics true
:temporal-extract true
:convert-timezone false
:test/jvm-timezone-setting true}]
(defmethod database-supports? [::driver feature] [_driver _feature _db] supported?)) | |
Escape a These aliases can be dynamically generated in [[metabase.query-processor.util.add-alias-info]] or elsewhere
(usually based on underlying table or column names) but can also be specified in the MBQL query itself for explicit
joins. For The default impl of [[escape-alias]] calls [[metabase.driver.impl/truncate-alias]] and truncates the alias to [[metabase.driver.impl/default-alias-max-length-bytes]]. You can call this function with a different max length if you need to generate shorter aliases. That method is currently only used drivers that derive from | (defmulti ^String escape-alias
{:added "0.42.0", :arglists '([driver column-or-table-alias])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
(defmethod escape-alias ::driver [_driver alias-name] (driver.impl/truncate-alias alias-name)) | |
Return a humanized (user-facing) version of an connection error message.
Generic error messages provided in [[metabase.driver.util/connection-error-messages]]; should be returned
as keywords whenever possible. This provides for both unified error messages and categories which let us point
users to the erroneous input fields.
Error messages can also be strings, or localized strings, as returned by [[metabase.util.i18n/trs]] and
| (defmulti humanize-connection-error-message
{:added "0.32.0" :arglists '([this message])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
(defmethod humanize-connection-error-message ::driver [_ message] message) | |
Transpile an MBQL query into the appropriate native query form. If the underlying query language supports remarks or comments, the driver should
use [[metabase.query-processor.util/query->remark]] to generate an appropriate message and include that in an
appropriate place; alternatively a driver might directly include the query's The result of this function will be passed directly into calls to [[execute-reducible-query]]. For example, a driver like Postgres would build a valid SQL expression and return a map such as: {:query "-- Metabase card: 10 user: 5 SELECT * FROM my_table"} | (defmulti mbql->native
{:added "0.32.0", :arglists '([driver query]), :style/indent 1}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
Pretty-format native form presumably coming from compiled query.
Used eg. in the API endpoint How to use and extend this method?At the time of writing, this method acts as identity for nosql drivers. However, story with sql drivers is a bit
different. To extend it for sql drivers, developers could use [[metabase.driver.sql.util/format-sql]]. Function
in question is implemented in a way, that developers, implemnting this multimethod can:
- Avoid implementing it completely, if their driver keyword representation corresponds to key in
[[metabase.driver.sql.util/dialects]] (eg. | (defmulti prettify-native-form
{:added "0.47.0", :arglists '([driver native-form]), :style/indent 1}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
(defmethod prettify-native-form ::driver [_ native-form] native-form) | |
For a native query that has separate parameters, such as a JDBC prepared statement, e.g. {:query "SELECT * FROM birds WHERE name = ?", :params ["Reggae"]} splice the parameters in to the native query as literals so it can be executed by the user, e.g. {:query "SELECT * FROM birds WHERE name = 'Reggae'"} This is used to power features such as 'Convert this Question to SQL' in the Query Builder. Normally when executing the query we'd like to leave the statement as a prepared one and pass parameters that way instead of splicing them in as literals so as to avoid SQL injection vulnerabilities. Thus the results of this method are not normally executed by the Query Processor when processing an MBQL query. However when people convert a question to SQL they can see what they will be executing and edit the query as needed. Input to this function follows the same shape as output of For databases that do not feature concepts like 'prepared statements', this method need not be implemented; the default implementation is an identity function. | (defmulti splice-parameters-into-native-query
{:added "0.32.0", :arglists '([driver query]), :style/indent 1}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
(defmethod splice-parameters-into-native-query ::driver [_ query] query) | |
Notify the driver that the attributes of a TODO - we should just have some sort of TODO -- shouldn't this be called | (defmulti notify-database-updated
{:added "0.32.0" :arglists '([driver database])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
(defmethod notify-database-updated ::driver [_ _] nil) ; no-op | |
Drivers may provide this function if they need to do special setup before a sync operation such as
(defn sync-in-context [driver database f] (with-connection [_ database] (f))) | (defmulti sync-in-context
{:added "0.32.0", :arglists '([driver database f]), :style/indent 2}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
(defmethod sync-in-context ::driver [_ _ f] (f)) | |
Return a sequence of all the rows in a given This method is currently only used by the H2 driver to load the Sample Database, so it is not neccesary for any other drivers to implement it at this time. | (defmulti table-rows-seq
{:added "0.32.0" :arglists '([driver database table])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
Return the system timezone ID name of this database, i.e. the timezone that local dates/times/datetimes are
considered to be in by default. Ideally, this method should return a timezone ID like This is currently used only when syncing the
Database (see [[metabase.sync.sync-metadata.sync-timezone/sync-timezone!]]) -- the result of this method is stored
in the In theory this method should probably not return This method should return a [[String]], a [[java.time.ZoneId]], or a [[java.time.ZoneOffset]]. | (defmulti db-default-timezone
{:added "0.34.0", :arglists '([driver database])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
(defmethod db-default-timezone ::driver [_driver _database] nil) | |
For drivers that support {:query "SELECT count(*) FROM table WHERE id = {{param}}" :template-tags {:param {:name "param", :display-name "Param", :type :number}} :parameters [{:type :number :target [:variable [:template-tag "param"]] :value 2}]} -> {:query "SELECT count(*) FROM table WHERE id = 2"} Much of the implementation for this method is shared across drivers and lives in the
| (defmulti substitute-native-parameters
{:added "0.34.0" :arglists '([driver inner-query])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
Return how fields should be sorted by default for this database. | (defmulti default-field-order
{:added "0.36.0" :arglists '([driver])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
(defmethod default-field-order ::driver [_] :database) | |
Return the day that is considered to be the start of week by TODO -- this can vary based on session variables or connection options | (defmulti db-start-of-week
{:added "0.37.0" :arglists '([driver])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
A multimethod for driver-specific behavior required to incorporate details for an opened SSH tunnel into the DB details. In most cases, this will simply involve updating the :host and :port (to point to the tunnel entry point, instead of the backing database server), but some drivers may have more specific behavior. WARNING! Implementations of this method may create new SSH tunnels, which need to be cleaned up. DO NOT USE THIS METHOD DIRECTLY UNLESS YOU ARE GOING TO BE CLEANING UP ANY CREATED TUNNELS! Instead, you probably want to use [[metabase.util.ssh/with-ssh-tunnel]]. See #24445 for more information. | (defmulti incorporate-ssh-tunnel-details
{:added "0.39.0" :arglists '([driver db-details])}
dispatch-on-uninitialized-driver
:hierarchy #'hierarchy) |
Normalizes db-details for the given driver. This is to handle migrations that are too difficult to perform via
regular Liquibase queries. This multimethod will be called from a TODO:
| (defmulti normalize-db-details
{:added "0.41.0" :arglists '([driver database])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
(defmethod normalize-db-details ::driver [_ db-details] ;; no normalization by default db-details) | |
Returns the driver that supersedes the given This is currently only used on the frontend for the purpose of showing/hiding deprecated drivers. A driver can make
use of this facility by adding a top-level | (defmulti superseded-by
{:added "0.41.0" :arglists '([driver])}
dispatch-on-uninitialized-driver
:hierarchy #'hierarchy) |
(defmethod superseded-by :default [_] nil) | |
Execute a writeback query e.g. one powering a custom | (defmulti execute-write-query!
{:changelog-test/ignore true, :added "0.44.0", :arglists '([driver query])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
Processes a sample of rows produced by | (defmulti table-rows-sample
{:arglists '([driver table fields rff opts]), :added "0.46.0"}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
Sets the database role used on a connection. Called prior to query execution for drivers that support connection impersonation (an EE-only feature). | (defmulti set-role!
{:added "0.47.0" :arglists '([driver conn role])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
+----------------------------------------------------------------------------------------------------------------+ | Upload | +----------------------------------------------------------------------------------------------------------------+ | |
The number of rows to insert at a time when uploading data to a database. This can be bound for testing purposes. | (def ^:dynamic *insert-chunk-rows* nil) |
Return the maximum number of characters allowed in a table name, or | (defmulti table-name-length-limit
{:changelog-test/ignore true, :added "0.47.0", :arglists '([driver])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
Create a table named | (defmulti create-table!
{:added "0.47.0", :arglists '([driver db-id table-name col->type])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
Drop a table named | (defmulti drop-table!
{:added "0.47.0", :arglists '([driver db-id table-name])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
Insert The types in | (defmulti insert-into!
{:added "0.47.0", :arglists '([driver db-id table-name column-names values])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
Add columns given by | (defmulti add-columns!
{:added "0.49.0", :arglists '([driver db-id table-name col->type])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
Returns the set of syncable schemas in the database (as strings). | (defmulti syncable-schemas
{:added "0.47.0", :arglists '([driver database])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
(defmethod syncable-schemas ::driver [_ _] #{}) | |
Returns the database type for a given
| (defmulti upload-type->database-type
{:changelog-test/ignore true, :added "0.47.0", :arglists '([driver upload-type])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
Returns the rows of data as arrays needed to populate the tabel_privileges table
with the DB connection's current user privileges.
The data contains the privileges that the user has on the given The rows have the following keys and value types: - role :- [:maybe :string] - schema :- [:maybe :string] - table :- :string - select :- :boolean - update :- :boolean - insert :- :boolean - delete :- :boolean Either: (1) role is null, corresponding to the privileges of the DB connection's current user (2) role is not null, corresponing to the privileges of the role | (defmulti current-user-table-privileges
{:added "0.48.0", :arglists '([driver database])}
dispatch-on-initialized-driver
:hierarchy #'hierarchy) |
Shared definitions and helper functions for use across different drivers. | (ns metabase.driver.common (:require [clojure.string :as str] [metabase.driver :as driver] [metabase.models.setting :as setting] [metabase.public-settings :as public-settings] [metabase.util.i18n :refer [deferred-tru trs]] [metabase.util.log :as log] [schema.core :as s]) (:import (org.joda.time DateTime))) |
(set! *warn-on-reflection* true) | |
TODO - we should rename these from | |
Map of the db host details field, useful for | (def default-host-details
{:name "host"
:display-name (deferred-tru "Host")
:helper-text (deferred-tru "Your database's IP address (e.g. 98.137.149.56) or its domain name (e.g. esc.mydatabase.com).")
:placeholder "name.database.com"}) |
Map of the db port details field, useful for | (def default-port-details
{:name "port"
:display-name (deferred-tru "Port")
:type :integer}) |
Map of the db user details field, useful for | (def default-user-details
{:name "user"
:display-name (deferred-tru "Username")
:placeholder (deferred-tru "username")
:required true}) |
Map of the db password details field, useful for | (def default-password-details
{:name "password"
:display-name (deferred-tru "Password")
:type :password
:placeholder "••••••••"}) |
Map of the db name details field, useful for | (def default-dbname-details
{:name "dbname"
:display-name (deferred-tru "Database name")
:placeholder (deferred-tru "birds_of_the_world")
:required true}) |
Map of the db ssl details field, useful for | (def default-ssl-details
{:name "ssl"
:display-name (deferred-tru "Use a secure connection (SSL)")
:type :boolean
:default false}) |
Map of the db | (def additional-options
{:name "additional-options"
:display-name (deferred-tru "Additional JDBC connection string options")
:visible-if {"advanced-options" true}}) |
Configuration parameters to include in the add driver page on drivers that support ssh tunnels | (def ssh-tunnel-preferences
[{:name "tunnel-enabled"
:display-name (deferred-tru "Use an SSH tunnel")
:placeholder (deferred-tru "Enable this SSH tunnel?")
:type :boolean
:default false}
{:name "tunnel-host"
:display-name (deferred-tru "SSH tunnel host")
:helper-text (deferred-tru "The hostname that you use to connect to SSH tunnels.")
:placeholder "hostname"
:required true
:visible-if {"tunnel-enabled" true}}
{:name "tunnel-port"
:display-name (deferred-tru "SSH tunnel port")
:type :integer
:default 22
:required false
:visible-if {"tunnel-enabled" true}}
{:name "tunnel-user"
:display-name (deferred-tru "SSH tunnel username")
:helper-text (deferred-tru "The username you use to login to your SSH tunnel.")
:placeholder "username"
:required true
:visible-if {"tunnel-enabled" true}}
;; this is entirely a UI flag
{:name "tunnel-auth-option"
:display-name (deferred-tru "SSH Authentication")
:type :select
:options [{:name (deferred-tru "SSH Key") :value "ssh-key"}
{:name (deferred-tru "Password") :value "password"}]
:default "ssh-key"
:visible-if {"tunnel-enabled" true}}
{:name "tunnel-pass"
:display-name (deferred-tru "SSH tunnel password")
:type :password
:placeholder "******"
:visible-if {"tunnel-auth-option" "password"}}
{:name "tunnel-private-key"
:display-name (deferred-tru "SSH private key to connect to the tunnel")
:type :string
:placeholder (deferred-tru "Paste the contents of an SSH private key here")
:required true
:visible-if {"tunnel-auth-option" "ssh-key"}}
{:name "tunnel-private-key-passphrase"
:display-name (deferred-tru "Passphrase for SSH private key")
:type :password
:placeholder "******"
:visible-if {"tunnel-auth-option" "ssh-key"}}]) |
Map representing the start of the advanced option section in a DB connection form. Fields in this section should
have their visibility controlled using the | (def advanced-options-start
{:name "advanced-options"
:type :section
:default false}) |
Map representing the | (def auto-run-queries
{:name "auto_run_queries"
:type :boolean
:default true
:display-name (deferred-tru "Rerun queries for simple explorations")
:description (deferred-tru
(str "We execute the underlying query when you explore data using Summarize or Filter. "
"This is on by default but you can turn it off if performance is slow."))
:visible-if {"advanced-options" true}}) |
Map representing the | (def let-user-control-scheduling
{:name "let-user-control-scheduling"
:type :boolean
:display-name (deferred-tru "Choose when syncs and scans happen")
:description (deferred-tru "By default, Metabase does a lightweight hourly sync and an intensive daily scan of field values. If you have a large database, turn this on to make changes.")
:visible-if {"advanced-options" true}}) |
Map representing the | (def metadata-sync-schedule
{:name "schedules.metadata_sync"
:display-name (deferred-tru "Database syncing")
:description (deferred-tru
(str "This is a lightweight process that checks for updates to this database’s schema. "
"In most cases, you should be fine leaving this set to sync hourly."))
:visible-if {"let-user-control-scheduling" true}}) |
Map representing the | (def cache-field-values-schedule
{:name "schedules.cache_field_values"
:display-name (deferred-tru "Scanning for Filter Values")
:description (deferred-tru
(str "Metabase can scan the values present in each field in this database to enable checkbox "
"filters in dashboards and questions. This can be a somewhat resource-intensive process, "
"particularly if you have a very large database. When should Metabase automatically scan "
"and cache field values?"))
:visible-if {"let-user-control-scheduling" true}}) |
Map representing the | (def json-unfolding
{:name "json-unfolding"
:display-name (deferred-tru "Allow unfolding of JSON columns")
:type :boolean
:visible-if {"advanced-options" true}
:description (deferred-tru
(str "This enables unfolding JSON columns into their component fields. "
"Disable unfolding if performance is slow. If enabled, you can still disable unfolding for "
"individual fields in their settings."))
:default true}) |
Map representing the | (def refingerprint
{:name "refingerprint"
:type :boolean
:display-name (deferred-tru "Periodically refingerprint tables")
:description (deferred-tru
(str "This enables Metabase to scan for additional field values during syncs allowing smarter "
"behavior, like improved auto-binning on your bar charts."))
:visible-if {"advanced-options" true}}) |
Vector containing the three most common options present in the advanced option section of the DB connection form. | (def default-advanced-options [auto-run-queries let-user-control-scheduling metadata-sync-schedule cache-field-values-schedule refingerprint]) |
Default options listed above, keyed by name. These keys can be listed in the plugin manifest to specify connection properties for drivers shipped as separate modules, e.g.: connection-properties: - db-name - host See the plugin manifest reference for more details. | (def default-options
{:dbname default-dbname-details
:host default-host-details
:password default-password-details
:port default-port-details
:ssl default-ssl-details
:user default-user-details
:ssh-tunnel ssh-tunnel-preferences
:additional-options additional-options
:advanced-options-start advanced-options-start
:default-advanced-options default-advanced-options}) |
Map of the | (def cloud-ip-address-info
{:name "cloud-ip-address-info"
:type :info
:getter (fn []
(when-let [ips (public-settings/cloud-gateway-ips)]
(str (deferred-tru
(str "If your database is behind a firewall, you may need to allow connections from our Metabase "
"[Cloud IP addresses](https://www.metabase.com/cloud/docs/ip-addresses-to-whitelist.html):"))
"\n"
(str/join " - " ips))))}) |
Default definitions for informational banners that can be included in a database connection form. These keys can be
added to the plugin manifest as connection properties, similar to the keys in the | (def default-connection-info-fields
{:cloud-ip-address-info cloud-ip-address-info}) |
+----------------------------------------------------------------------------------------------------------------+ | Class -> Base Type | +----------------------------------------------------------------------------------------------------------------+ | |
Return the | (defn class->base-type
[klass]
(condp #(isa? %2 %1) klass
Boolean :type/Boolean
Double :type/Float
Float :type/Float
Integer :type/Integer
Long :type/Integer
java.math.BigDecimal :type/Decimal
java.math.BigInteger :type/BigInteger
Number :type/Number
String :type/Text
;; java.sql types and Joda-Time types should be considered DEPRECATED
java.sql.Date :type/Date
java.sql.Timestamp :type/DateTime
java.util.Date :type/Date
DateTime :type/DateTime
java.util.UUID :type/UUID
clojure.lang.IPersistentMap :type/Dictionary
clojure.lang.IPersistentVector :type/Array
java.time.LocalDate :type/Date
java.time.LocalTime :type/Time
java.time.LocalDateTime :type/DateTime
;; `OffsetTime` and `OffsetDateTime` should be mapped to one of `type/TimeWithLocalTZ`/`type/TimeWithZoneOffset`
;; and `type/DateTimeWithLocalTZ`/`type/DateTimeWithZoneOffset` respectively. We can't really tell how they're
;; stored in the DB based on class alone, so drivers should return more specific types where possible. See
;; discussion in the `metabase.types` namespace.
java.time.OffsetTime :type/TimeWithTZ
java.time.OffsetDateTime :type/DateTimeWithTZ
java.time.ZonedDateTime :type/DateTimeWithZoneID
java.time.Instant :type/Instant
;; TODO - this should go in the Postgres driver implementation of this method rather than here
org.postgresql.util.PGobject :type/*
;; all-NULL columns in DBs like Mongo w/o explicit types
nil :type/*
(do
(log/warn (trs "Don''t know how to map class ''{0}'' to a Field base_type, falling back to :type/*." klass))
:type/*))) |
Number of result rows to sample when when determining base type. | (def ^:private column-info-sample-size 100) |
Transducer that given a sequence of | (defn values->base-type
[]
((comp (filter some?) (take column-info-sample-size) (map class))
(fn
([]
(doto (java.util.HashMap.)
(.put nil 0))) ; fallback to keep `max-key` happy if no values
([^java.util.HashMap freqs, klass]
(.put freqs klass (inc (.getOrDefault freqs klass 0)))
freqs)
([freqs]
(->> freqs
(apply max-key val)
key
class->base-type))))) |
(def ^:private ^clojure.lang.PersistentVector days-of-week [:monday :tuesday :wednesday :thursday :friday :saturday :sunday]) | |
Used to override the [[metabase.public-settings/start-of-week]] settings. Primarily being used to calculate week-of-year in US modes where the start-of-week is always Sunday. More in (defmethod date [:sql :week-of-year-us]). | (def ^:dynamic *start-of-week* nil) |
(s/defn start-of-week->int :- (s/pred (fn [n] (and (integer? n) (<= 0 n 6)))
"Start of week integer")
"Returns the int value for the current [[metabase.public-settings/start-of-week]] Setting value, which ranges from
`0` (`:monday`) to `6` (`:sunday`). This is guaranteed to return a value."
{:added "0.42.0"}
[]
(.indexOf days-of-week (or *start-of-week* (setting/get-value-of-type :keyword :start-of-week)))) | |
Like [[start-of-week-offset]] but takes a | (defn start-of-week-offset-for-day
[start-of-week]
(let [db-start-of-week (.indexOf days-of-week start-of-week)
target-start-of-week (start-of-week->int)
delta (int (- target-start-of-week db-start-of-week))]
(* (Integer/signum delta)
(- 7 (Math/abs delta))))) |
(s/defn start-of-week-offset :- s/Int "Return the offset needed to adjust a day of the week (in the range 1..7) returned by the `driver`, with `1` corresponding to [[driver/db-start-of-week]], so that `1` corresponds to [[metabase.public-settings/start-of-week]] in results. e.g. If `:my-driver` returns [[driver/db-start-of-week]] as `:sunday` (1 is Sunday, 2 is Monday, and so forth), and [[metabase.public-settings/start-of-week]] is `:monday` (the results should have 1 as Monday, 2 as Tuesday... 7 is Sunday), then the offset should be `-1`, because `:monday` returned by the driver (`2`) minus `1` = `1`." [driver] (start-of-week-offset-for-day (driver/db-start-of-week driver))) | |
Returns true if JSON fields should be unfolded by default for this database, and false otherwise. | (defn json-unfolding-default
[database]
;; This allows adding support for nested-field-columns for drivers in the future and
;; have json-unfolding enabled by default, without
;; needing a migration to add the `json-unfolding=true` key to the database details.
(let [json-unfolding (get-in database [:details :json-unfolding])]
(if (nil? json-unfolding)
true
json-unfolding))) |
Various record types below are used as a convenience for differentiating the different param types. | (ns metabase.driver.common.parameters (:require [potemkin.types :as p.types] [pretty.core :as pretty])) |
"FieldFilter" is something that expands to a clause like "some_field BETWEEN 1 AND 10"
{:type :date/single :value #t "2019-09-20T19:52:00.000-07:00"}
| (p.types/defrecord+ FieldFilter [field value]
pretty/PrettyPrintable
(pretty [this]
(list (pretty/qualify-symbol-for-*ns* `map->FieldFilter) (into {} this)))) |
Is | (defn FieldFilter? [x] (instance? FieldFilter x)) |
A "ReferencedCardQuery" parameter expands to the native query of the referenced card.
| (p.types/defrecord+ ReferencedCardQuery [card-id query params]
pretty/PrettyPrintable
(pretty [this]
(list (pretty/qualify-symbol-for-*ns* `map->ReferencedCardQuery) (into {} this)))) |
Is | (defn ReferencedCardQuery? [x] (instance? ReferencedCardQuery x)) |
A
| (p.types/defrecord+ ReferencedQuerySnippet [snippet-id content]
pretty/PrettyPrintable
(pretty [this]
(list (pretty/qualify-symbol-for-*ns* `map->ReferencedQuerySnippet) (into {} this)))) |
Is | (defn ReferencedQuerySnippet? [x] (instance? ReferencedQuerySnippet x)) |
as in a literal date, defined by date-string S TODO - why don't we just parse this into a Temporal type and let drivers handle it. | (p.types/defrecord+ Date [^String s]
pretty/PrettyPrintable
(pretty [_]
(list (pretty/qualify-symbol-for-*ns* `->Date) s))) |
(p.types/defrecord+ DateRange [start end]
pretty/PrettyPrintable
(pretty [_]
(list (pretty/qualify-symbol-for-*ns* `->DateRange) start end))) | |
Convenience for representing an optional parameter present in a query but whose value is unspecified in the param values. | (def no-value ::no-value) |
(p.types/defrecord+ Param [k]
pretty/PrettyPrintable
(pretty [_]
(list (pretty/qualify-symbol-for-*ns* `->Param) k))) | |
(p.types/defrecord+ Optional [args]
pretty/PrettyPrintable
(pretty [_]
(cons (pretty/qualify-symbol-for-*ns* `->Optional) args))) | |
Is
| (defn Param? [x] (instance? Param x)) |
Is | (defn Optional? [x] (instance? Optional x)) |
Shared code for handling datetime parameters, used by both MBQL and native params implementations. | (ns metabase.driver.common.parameters.dates (:require [clojure.string :as str] [java-time.api :as t] [medley.core :as m] [metabase.mbql.schema :as mbql.s] [metabase.mbql.util :as mbql.u] [metabase.models.params :as params] [metabase.query-processor.error-type :as qp.error-type] [metabase.util.date-2 :as u.date] [metabase.util.i18n :refer [tru]] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms]) (:import (java.time.temporal Temporal))) |
(set! *warn-on-reflection* true) | |
Is param type | (mu/defn date-type? [param-type :- :keyword] (= (get-in mbql.s/parameter-types [param-type :type]) :date)) |
Does date | (defn not-single-date-type?
[param-type]
(and (date-type? param-type)
(not (#{:date/single :date} param-type)))) |
Both in MBQL and SQL parameter substitution a field value is compared to a date range, either relative or absolute. Currently the field value is casted to a day (ignoring the time of day), so the ranges should have the same granularity level. See https://github.com/metabase/metabase/pull/4607#issuecomment-290884313 how we could support hour/minute granularity in field parameter queries. | |
(defn- day-range
[start end]
{:start start :end end :unit :day}) | |
(defn- comparison-range
([t unit]
(comparison-range t t unit :day))
([start end unit]
(comparison-range start end unit :day))
([start end unit resolution]
(merge
(u.date/comparison-range start unit :>= {:resolution resolution})
(u.date/comparison-range end unit :<= {:resolution resolution, :end :inclusive})
{:unit unit}))) | |
(defn- second-range [start end] (comparison-range start end :second :second)) | |
(defn- minute-range [start end] (comparison-range start end :minute :minute)) | |
(defn- hour-range [start end] (comparison-range start end :hour :hour)) | |
(defn- week-range [start end] (comparison-range start end :week)) | |
(defn- month-range [start end] (comparison-range start end :month)) | |
(defn- year-range [start end] (comparison-range start end :year)) | |
(defn- relative-quarter-range [start end] (comparison-range start end :quarter)) | |
(defn- absolute-quarter-range
[quarter year]
(let [year-quarter (t/year-quarter year (case quarter
"Q1" 1
"Q2" 2
"Q3" 3
"Q4" 4))]
{:start (.atDay year-quarter 1)
:end (.atEndOfQuarter year-quarter)
:unit :quarter})) | |
(def ^:private operations-by-date-unit
{"second" {:unit-range second-range
:to-period t/seconds}
"minute" {:unit-range minute-range
:to-period t/minutes}
"hour" {:unit-range hour-range
:to-period t/hours}
"day" {:unit-range day-range
:to-period t/days}
"week" {:unit-range week-range
:to-period t/weeks}
"month" {:unit-range month-range
:to-period t/months}
"quarter" {:unit-range relative-quarter-range
:to-period (comp t/months (partial * 3))}
"year" {:unit-range year-range
:to-period t/years}}) | |
(defn- maybe-reduce-resolution [unit dt]
(if (contains? #{"second" "minute" "hour"} unit)
dt
; for units that are a day or longer, convert back to LocalDate
(t/local-date dt))) | |
+----------------------------------------------------------------------------------------------------------------+ | DATE STRING DECODERS | +----------------------------------------------------------------------------------------------------------------+ | |
For parsing date strings and producing either a date range (for raw SQL parameter substitution) or a MBQL clause | |
(defn- expand-parser-groups
[group-label group-value]
(when group-value
(case group-label
:unit (conj (seq (get operations-by-date-unit group-value))
[group-label group-value])
(:int-value :int-value-1) [[group-label (Integer/parseInt group-value)]]
(:date :date-1 :date-2) [[group-label (u.date/parse group-value)]]
[[group-label group-value]]))) | |
(mu/defn ^:private regex->parser :- fn?
"Takes a regex and labels matching the regex capturing groups. Returns a parser which takes a parameter value,
validates the value against regex and gives a map of labels and group values. Respects the following special label
names:
:unit – finds a matching date unit and merges date unit operations to the result
:int-value, :int-value-1 – converts the group value to integer
:date, :date1, date2 – converts the group value to absolute date"
[regex :- [:fn {:error/message "regular expression"} m/regexp?] group-labels]
(fn [param-value]
(when-let [regex-result (re-matches regex param-value)]
(into {} (mapcat expand-parser-groups group-labels (rest regex-result)))))) | |
Decorders consist of: 1) Parser which tries to parse the date parameter string 2) Range decoder which takes the parser output and produces a date range relative to the given datetime 3) Filter decoder which takes the parser output and produces a mbql clause for a given mbql field reference | |
(def ^:private temporal-units-regex #"(millisecond|second|minute|hour|day|week|month|quarter|year)") (def ^:private relative-suffix-regex (re-pattern (format "(|~|-from-([0-9]+)%ss)" temporal-units-regex))) | |
Adding a tilde (~) at the end of a past | (defn- include-current? [relative-suffix] (= "~" relative-suffix)) |
(defn- with-temporal-unit-if-field
[clause unit]
(cond-> clause
(mbql.u/is-clause? :field clause) (mbql.u/with-temporal-unit unit))) | |
(def ^:private relative-date-string-decoders
[{:parser #(= % "today")
:range (fn [_ dt]
(let [dt-res (t/local-date dt)]
{:start dt-res,
:end dt-res
:unit :day}))
:filter (fn [_ field-clause]
[:= (with-temporal-unit-if-field field-clause :day) [:relative-datetime :current]])}
{:parser #(= % "yesterday")
:range (fn [_ dt]
(let [dt-res (t/local-date dt)]
{:start (t/minus dt-res (t/days 1))
:end (t/minus dt-res (t/days 1))
:unit :day}))
:filter (fn [_ field-clause]
[:= (with-temporal-unit-if-field field-clause :day) [:relative-datetime -1 :day]])}
;; Adding a tilde (~) at the end of a past<n><unit>s filter means we should include the current day/etc.
;; e.g. past30days = past 30 days, not including partial data for today ({:include-current false})
;; past30days~ = past 30 days, *including* partial data for today ({:include-current true}).
;; Adding a -from-<n><unit>s suffix at the end of the filter means we want to offset the range in the
;; case of past filters into the past, in the case of next filters into the future.
;; The implementation below uses the fact that if the relative suffix is not empty, then the
;; include-current flag is true.
{:parser (regex->parser (re-pattern (str #"past([0-9]+)" temporal-units-regex #"s" relative-suffix-regex))
[:int-value :unit :relative-suffix :int-value-1 :unit-1])
:range (fn [{:keys [unit int-value unit-range to-period relative-suffix unit-1 int-value-1]} dt]
(let [dt-offset (cond-> dt
unit-1 (t/minus ((get-in operations-by-date-unit [unit-1 :to-period]) int-value-1)))
dt-resolution (maybe-reduce-resolution unit dt-offset)]
(unit-range (t/minus dt-resolution (to-period int-value))
(t/minus dt-resolution (to-period (if (include-current? relative-suffix) 0 1))))))
:filter (fn [{:keys [unit int-value relative-suffix unit-1 int-value-1]} field-clause]
(if unit-1
[:between
[:+ field-clause [:interval int-value-1 (keyword unit-1)]]
[:relative-datetime (- int-value) (keyword unit)]
[:relative-datetime 0 (keyword unit)]]
[:time-interval field-clause (- int-value) (keyword unit) {:include-current (include-current? relative-suffix)}]))}
{:parser (regex->parser (re-pattern (str #"next([0-9]+)" temporal-units-regex #"s" relative-suffix-regex))
[:int-value :unit :relative-suffix :int-value-1 :unit-1])
:range (fn [{:keys [unit int-value unit-range to-period relative-suffix unit-1 int-value-1]} dt]
(let [dt-offset (cond-> dt
unit-1 (t/plus ((get-in operations-by-date-unit [unit-1 :to-period]) int-value-1)))
dt-resolution (maybe-reduce-resolution unit dt-offset)]
(unit-range (t/plus dt-resolution (to-period (if (include-current? relative-suffix) 0 1)))
(t/plus dt-resolution (to-period int-value)))))
:filter (fn [{:keys [unit int-value relative-suffix unit-1 int-value-1]} field-clause]
(if unit-1
[:between
[:+ field-clause [:interval (- int-value-1) (keyword unit-1)]]
[:relative-datetime 0 (keyword unit)]
[:relative-datetime int-value (keyword unit)]]
[:time-interval field-clause int-value (keyword unit) {:include-current (include-current? relative-suffix)}]))}
{:parser (regex->parser (re-pattern (str #"last" temporal-units-regex))
[:unit])
:range (fn [{:keys [unit unit-range to-period]} dt]
(let [last-unit (t/minus (maybe-reduce-resolution unit dt) (to-period 1))]
(unit-range last-unit last-unit)))
:filter (fn [{:keys [unit]} field-clause]
[:time-interval field-clause :last (keyword unit)])}
{:parser (regex->parser (re-pattern (str #"this" temporal-units-regex))
[:unit])
:range (fn [{:keys [unit unit-range]} dt]
(let [dt-adj (maybe-reduce-resolution unit dt)]
(unit-range dt-adj dt-adj)))
:filter (fn [{:keys [unit]} field-clause]
[:time-interval field-clause :current (keyword unit)])}]) | |
(defn- ->iso-8601-date [t] (t/format :iso-local-date t)) | |
(defn- ->iso-8601-date-time [t] (t/format :iso-local-date-time t)) | |
TODO - using | (defn- range->filter
[{:keys [start end]} field-clause]
[:between (with-temporal-unit-if-field field-clause :day) (->iso-8601-date start) (->iso-8601-date end)]) |
(def ^:private short-day->day
{"Mon" :monday
"Tue" :tuesday
"Wed" :wednesday
"Thu" :thursday
"Fri" :friday
"Sat" :saturday
"Sun" :sunday}) | |
(def ^:private short-month->month
(into {}
(map-indexed (fn [i m] [m (inc i)]))
["Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"])) | |
(defn- parse-int-in-range [s min-val max-val]
(try
(let [i (Integer/parseInt s)]
(when (<= min-val i max-val)
i))
(catch NumberFormatException _))) | |
(defn- excluded-datetime [unit date exclusion]
(let [year (t/year date)]
(case unit
:hour (when-let [hour (parse-int-in-range exclusion 0 23)]
(format "%sT%02d:00:00Z" date hour))
:day (when-let [day (short-day->day exclusion)]
(str (t/adjust date :next-or-same-day-of-week day)))
:month (when-let [month (short-month->month exclusion)]
(format "%s-%02d-01" year month))
:quarter (when-let [quarter (parse-int-in-range exclusion 1 4)]
(format "%s-%02d-01" year (inc (* 3 (dec quarter)))))
nil))) | |
(def ^:private excluded-temporal-unit
{:hour :hour-of-day
:day :day-of-week
:month :month-of-year
:quarter :quarter-of-year}) | |
Regex to match date exclusion values, e.g. exclude-days-Mon, exclude-months-Jan, etc. | (def date-exclude-regex
(re-pattern (str "exclude-" temporal-units-regex #"s-([-\p{Alnum}]+)"))) |
(defn- absolute-date->unit
[date-string]
(if (str/includes? date-string "T")
;; on the UI you can specify the time up to the minute, so we use minute here
:minute
:day)) | |
(def ^:private absolute-date-string-decoders
;; year and month
[{:parser (regex->parser #"([0-9]{4}-[0-9]{2})" [:date])
:range (fn [{:keys [date]} _]
(month-range date date))
:filter (fn [{:keys [date]} field-clause]
(range->filter (month-range date date) field-clause))}
;; quarter year
{:parser (regex->parser #"(Q[1-4]{1})-([0-9]{4})" [:quarter :year])
:range (fn [{:keys [quarter year]} _]
(absolute-quarter-range quarter (Integer/parseInt year)))
:filter (fn [{:keys [quarter year]} field-clause]
(range->filter (absolute-quarter-range quarter (Integer/parseInt year))
field-clause))}
;; single day
{:parser (regex->parser #"([0-9-T:]+)" [:date])
:range (fn [{:keys [date]} _]
{:start date :end date :unit (absolute-date->unit date)})
:filter (fn [{:keys [date]} field-clause]
(let [iso8601date (->iso-8601-date date)]
[:= (with-temporal-unit-if-field field-clause :day) iso8601date]))}
;; day range
{:parser (regex->parser #"([0-9-T]+)~([0-9-T]+)" [:date-1 :date-2])
:range (fn [{:keys [date-1 date-2]} _]
{:start date-1 :end date-2 :unit (absolute-date->unit date-1)})
:filter (fn [{:keys [date-1 date-2]} field-clause]
[:between (with-temporal-unit-if-field field-clause :day) (->iso-8601-date date-1) (->iso-8601-date date-2)])}
;; datetime range
{:parser (regex->parser #"([0-9-T:]+)~([0-9-T:]+)" [:date-1 :date-2])
:range (fn [{:keys [date-1 date-2]} _]
{:start date-1, :end date-2 :unit (absolute-date->unit date-1)})
:filter (fn [{:keys [date-1 date-2]} field-clause]
[:between (with-temporal-unit-if-field field-clause :default)
(->iso-8601-date-time date-1)
(->iso-8601-date-time date-2)])}
;; before day
{:parser (regex->parser #"~([0-9-T:]+)" [:date])
:range (fn [{:keys [date]} _]
{:end date :unit (absolute-date->unit date)})
:filter (fn [{:keys [date]} field-clause]
[:< (with-temporal-unit-if-field field-clause :day) (->iso-8601-date date)])}
;; after day
{:parser (regex->parser #"([0-9-T:]+)~" [:date])
:range (fn [{:keys [date]} _]
{:start date :unit (absolute-date->unit date)})
:filter (fn [{:keys [date]} field-clause]
[:> (with-temporal-unit-if-field field-clause :day) (->iso-8601-date date)])}
;; exclusions
{:parser (regex->parser date-exclude-regex [:unit :exclusions])
:filter (fn [{:keys [unit exclusions]} field-clause]
(let [unit (keyword unit)
exclusions (map (partial excluded-datetime unit (t/local-date))
(str/split exclusions #"-"))]
(when (and (seq exclusions) (every? some? exclusions))
(into [:!= (with-temporal-unit-if-field field-clause (excluded-temporal-unit unit))] exclusions))))}]) | |
(def ^:private all-date-string-decoders (concat relative-date-string-decoders absolute-date-string-decoders)) | |
Returns the first successfully decoded value, run through both parser and a range/filter decoder depending on
| (mu/defn ^:private execute-decoders
[decoders
decoder-type :- [:enum :range :filter]
decoder-param
date-string :- :string]
(some (fn [{parser :parser, parser-result-decoder decoder-type}]
(when-let [parser-result (and parser-result-decoder (parser date-string))]
(parser-result-decoder parser-result decoder-param)))
decoders)) |
(def ^:private TemporalUnit (into [:enum] u.date/add-units)) | |
(def ^:private TemporalRange
[:map
[:start {:optional true} [:fn #(instance? Temporal %)]]
[:end {:optional true} [:fn #(instance? Temporal %)]]
[:unit TemporalUnit]]) | |
(mu/defn ^:private adjust-inclusive-range-if-needed :- [:maybe TemporalRange]
"Make an inclusive date range exclusive as needed."
[{:keys [inclusive-start? inclusive-end?]} temporal-range :- [:maybe TemporalRange]]
(-> temporal-range
(m/update-existing :start #(if inclusive-start?
%
(u.date/add % (case (:unit temporal-range)
(:year :quarter :month :week :day)
:day
(:unit temporal-range)) -1)))
(m/update-existing :end #(if inclusive-end?
%
(u.date/add % (case (:unit temporal-range)
(:year :quarter :month :week :day)
:day
(:unit temporal-range)) 1))))) | |
Schema for a valid date range returned by | (def ^:private DateStringRange
[:and [:map {:closed true}
[:start {:optional true} ms/NonBlankString]
[:end {:optional true} ms/NonBlankString]]
[:fn {:error/message "must have either :start or :end"}
(fn [{:keys [start end]}]
(or start end))]
[:fn {:error/message ":start must come before :end"}
(fn [{:keys [start end]}]
(or (not start)
(not end)
(not (pos? (compare start end)))))]]) |
(defn- format-date-range
[date-range]
(-> date-range
(m/update-existing :start u.date/format)
(m/update-existing :end u.date/format)
(dissoc :unit))) | |
(mu/defn date-string->range :- DateStringRange
"Takes a string description of a date range such as `lastmonth` or `2016-07-15~2016-08-6` and returns a map with
`:start` and/or `:end` keys, as ISO-8601 *date* strings. By default, `:start` and `:end` are inclusive,
e.g:
(date-string->range \"past2days\") ; -> {:start \"2020-01-20\", :end \"2020-01-21\"}
intended for use with SQL like
WHERE date(some_column) BETWEEN date '2020-01-20' AND date '2020-01-21'
which is *INCLUSIVE*. If the filter clause you're generating is not inclusive, pass the `:inclusive-start?` or
`:inclusive-end?` options as needed to generate an appropriate range.
Note that some ranges are open-ended on one side, and will have only a `:start` or an `:end`."
;; 1-arg version returns inclusive start/end; 2-arg version can adjust as needed
([date-string]
(date-string->range date-string nil))
([date-string :- ms/NonBlankString
{:keys [inclusive-start? inclusive-end?]
:or {inclusive-start? true inclusive-end? true}}]
(let [options {:inclusive-start? inclusive-start?, :inclusive-end? inclusive-end?}
now (t/local-date-time)]
;; Relative dates respect the given time zone because a notion like "last 7 days" might mean a different range of
;; days depending on the user timezone
(or (->> (execute-decoders relative-date-string-decoders :range now date-string)
(adjust-inclusive-range-if-needed options)
format-date-range)
;; Absolute date ranges don't need the time zone conversion because in SQL the date ranges are compared
;; against the db field value that is casted granularity level of a day in the db time zone
(->> (execute-decoders absolute-date-string-decoders :range nil date-string)
(adjust-inclusive-range-if-needed options)
format-date-range)
;; if both of the decoders above fail, then the date string is invalid
(throw (ex-info (tru "Don''t know how to parse date param ''{0}'' — invalid format" date-string)
{:param date-string
:type qp.error-type/invalid-parameter})))))) | |
(mu/defn date-string->filter :- mbql.s/Filter
"Takes a string description of a *date* (not datetime) range such as 'lastmonth' or '2016-07-15~2016-08-6' and
returns a corresponding MBQL filter clause for a given field reference."
[date-string :- :string
field :- [:or ms/PositiveInt mbql.s/Field]]
(or (execute-decoders all-date-string-decoders :filter (params/wrap-field-id-if-needed field) date-string)
(throw (ex-info (tru "Don''t know how to parse date string {0}" (pr-str date-string))
{:type qp.error-type/invalid-parameter
:date-string date-string})))) | |
This namespace handles parameters that are operators. {:type :number/between :target [:dimension [:field 26 {:source-field 5}]] :value [3 5]} | (ns metabase.driver.common.parameters.operators (:require [metabase.mbql.schema :as mbql.s] [metabase.models.params :as params] [metabase.query-processor.error-type :as qp.error-type] [metabase.util.i18n :refer [tru]] [metabase.util.malli :as mu] [schema.core :as s])) |
(s/defn ^:private operator-arity :- (s/maybe (s/enum :unary :binary :variadic)) [param-type] (get-in mbql.s/parameter-types [param-type :operator])) | |
Returns whether param-type is an "operator" type. | (defn operator? [param-type] (boolean (operator-arity param-type))) |
(s/defn ^:private verify-type-and-arity
[field param-type param-value]
(letfn [(maybe-arity-error [n]
(when (not= n (count param-value))
(throw (ex-info (format "Operations Invalid arity: expected %s but received %s"
n (count param-value))
{:param-type param-type
:param-value param-value
:field-id (second field)
:type qp.error-type/invalid-parameter}))))]
(condp = (operator-arity param-type)
:unary
(maybe-arity-error 1)
:binary
(maybe-arity-error 2)
:variadic
(when-not (sequential? param-value)
(throw (ex-info (tru "Invalid values provided for operator: {0}" param-type)
{:param-type param-type
:param-value param-value
:field-id (second field)
:type qp.error-type/invalid-parameter})))
(throw (ex-info (tru "Unrecognized operation: {0}" param-type)
{:param-type param-type
:param-value param-value
:field-id (second field)
:type qp.error-type/invalid-parameter}))))) | |
(mu/defn to-clause :- mbql.s/Filter
"Convert an operator style parameter into an mbql clause. Will also do arity checks and throws an ex-info with
`:type qp.error-type/invalid-parameter` if arity is incorrect."
[{param-type :type [a b :as param-value] :value [_ field :as _target] :target options :options :as _param}]
(verify-type-and-arity field param-type param-value)
(let [field' (params/wrap-field-id-if-needed field)]
(case (operator-arity param-type)
:binary
(cond-> [(keyword (name param-type)) field' a b]
(boolean options) (conj options))
:unary
(cond-> [(keyword (name param-type)) field' a]
(boolean options) (conj options))
:variadic
(cond-> (into [(keyword (name param-type)) field'] param-value)
(boolean options) (conj options))
(throw (ex-info (format "Unrecognized operator: %s" param-type)
{:param-type param-type
:param-value param-value
:field-id (second field)
:type qp.error-type/invalid-parameter}))))) | |
(ns metabase.driver.common.parameters.parse (:require [clojure.string :as str] [metabase.driver.common.parameters :as params] [metabase.query-processor.error-type :as qp.error-type] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log] [schema.core :as s]) (:import (metabase.driver.common.parameters Optional Param))) | |
(set! *warn-on-reflection* true) | |
(def ^:private StringOrToken (s/cond-pre s/Str {:token s/Keyword
:text s/Str})) | |
(def ^:private ParsedToken (s/cond-pre s/Str Param Optional)) | |
Returns any adjacent strings in coll combined together | (defn- combine-adjacent-strings
[coll]
(apply concat
(for [subseq (partition-by string? coll)]
(if (string? (first subseq))
[(apply str subseq)]
subseq)))) |
Returns a vector of [index match] for string or regex pattern found in s | (defn- find-token
[s pattern]
(if (string? pattern)
(when-let [index (str/index-of s pattern)]
[index pattern])
(let [m (re-matcher pattern s)]
(when (.find m)
[(.start m) (subs s (.start m) (.end m))])))) |
(defn- tokenize-one [s pattern token]
(loop [acc [], s s]
(if (empty? s)
acc
(if-let [[index text] (find-token s pattern)]
(recur (conj acc (subs s 0 index) {:text text :token token})
(subs s (+ index (count text))))
(conj acc s))))) | |
(def ^:private param-token-patterns
[["[[" :optional-begin]
["]]" :optional-end]
;; param-begin should only match the last two opening brackets in a sequence of > 2, e.g.
;; [{$match: {{{x}}, field: 1}}] should parse to ["[$match: {" (param "x") ", field: 1}}]"]
[#"(?s)\{\{(?!\{)" :param-begin]
["}}" :param-end]]) | |
(def ^:private sql-token-patterns
(concat
[["/*" :block-comment-begin]
["*/" :block-comment-end]
["--" :line-comment-begin]
["\n" :newline]]
param-token-patterns)) | |
(s/defn ^:private tokenize :- [StringOrToken]
[s :- s/Str, handle-sql-comments :- s/Bool]
(reduce
(fn [strs [token-str token]]
(filter
(some-fn keyword? seq)
(mapcat
(fn [s]
(if-not (string? s)
[s]
(tokenize-one s token-str token)))
strs)))
[s]
(if handle-sql-comments
sql-token-patterns
param-token-patterns))) | |
(defn- param [& [k & more]]
(when (or (seq more)
(not (string? k)))
(throw (ex-info (tru "Invalid '{{...}}' clause: expected a param name")
{:type qp.error-type/invalid-query})))
(let [k (str/trim k)]
(when (empty? k)
(throw (ex-info (tru "'{{...}}' clauses cannot be empty.")
{:type qp.error-type/invalid-query})))
(params/->Param k))) | |
(defn- optional [& parsed]
(when-not (some params/Param? parsed)
(throw (ex-info (tru "'[[...]]' clauses must contain at least one '{{...}}' clause.")
{:type qp.error-type/invalid-query})))
(params/->Optional (combine-adjacent-strings parsed))) | |
(s/defn ^:private parse-tokens* :- [(s/one [ParsedToken] "parsed tokens") (s/one [StringOrToken] "remaining tokens")]
[tokens :- [StringOrToken]
optional-level :- s/Int
param-level :- s/Int
comment-mode :- (s/enum nil :block-comment-begin :line-comment-begin)]
(loop [acc [], [string-or-token & more] tokens]
(cond
(nil? string-or-token)
(if (or (pos? optional-level) (pos? param-level))
(throw (ex-info (tru "Invalid query: found '[[' or '{{' with no matching ']]' or '}}'")
{:type qp.error-type/invalid-query}))
[acc nil])
(string? string-or-token)
(recur (conj acc string-or-token) more)
:else
(let [{:keys [text token]} string-or-token]
(case token
:optional-begin
(if comment-mode
(recur (conj acc text) more)
(let [[parsed more] (parse-tokens* more (inc optional-level) param-level comment-mode)]
(recur (conj acc (apply optional parsed)) more)))
:param-begin
(if comment-mode
(recur (conj acc text) more)
(let [[parsed more] (parse-tokens* more optional-level (inc param-level) comment-mode)]
(recur (conj acc (apply param parsed)) more)))
(:line-comment-begin :block-comment-begin)
(if (or comment-mode (pos? optional-level))
(recur (conj acc text) more)
(let [[parsed more] (parse-tokens* more optional-level param-level token)]
(recur (into acc (cons text parsed)) more)))
:block-comment-end
(if (= comment-mode :block-comment-begin)
[(conj acc text) more]
(recur (conj acc text) more))
:newline
(if (= comment-mode :line-comment-begin)
[(conj acc text) more]
(recur (conj acc text) more))
:optional-end
(if (pos? optional-level)
[acc more]
(recur (conj acc text) more))
:param-end
(if (pos? param-level)
[acc more]
(recur (conj acc text) more))))))) | |
(s/defn parse :- [(s/cond-pre s/Str Param Optional)]
"Attempts to parse parameters in string `s`. Parses any optional clauses or parameters found, and returns a sequence
of non-parameter string fragments (possibly) interposed with `Param` or `Optional` instances.
If `handle-sql-comments` is true (default) then we make a best effort to ignore params in SQL comments."
([s :- s/Str]
(parse s true))
([s :- s/Str, handle-sql-comments :- s/Bool]
(let [tokenized (tokenize s handle-sql-comments)]
(if (= [s] tokenized)
[s]
(do
(log/tracef "Tokenized native query ->\n%s" (u/pprint-to-str tokenized))
(u/prog1 (combine-adjacent-strings (first (parse-tokens* tokenized 0 0 nil)))
(log/tracef "Parsed native query ->\n%s" (u/pprint-to-str <>)))))))) | |
These functions build a map of information about the types and values of the params used in a query. (These functions
don't parse the query itself, but instead look at the values of (query->params-map some-inner-query) ;; -> {"checkindate" {:field {:name "date", :parentid nil, :table_id 1375} :param {:type "date/range" :target ["dimension" ["template-tag" "checkin_date"]] :value "2015-01-01~2016-09-01"}}} | (ns metabase.driver.common.parameters.values
(:require
[clojure.string :as str]
[metabase.driver.common.parameters :as params]
[metabase.lib.metadata :as lib.metadata]
[metabase.lib.metadata.protocols :as lib.metadata.protocols]
[metabase.lib.schema.template-tag :as lib.schema.template-tag]
[metabase.mbql.schema :as mbql.s]
[metabase.models.native-query-snippet :refer [NativeQuerySnippet]]
[metabase.query-processor :as qp]
[metabase.query-processor.error-type :as qp.error-type]
[metabase.query-processor.store :as qp.store]
[metabase.query-processor.util.persisted-cache :as qp.persistence]
[metabase.util :as u]
[metabase.util.i18n :refer [tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
#_{:clj-kondo/ignore [:discouraged-namespace]}
[toucan2.core :as t2])
(:import
(clojure.lang ExceptionInfo)
(java.text NumberFormat)
(java.util UUID))) |
(set! *warn-on-reflection* true) | |
(def ^:private Date (ms/InstanceOfClass metabase.driver.common.parameters.Date)) (def ^:private FieldFilter (ms/InstanceOfClass metabase.driver.common.parameters.FieldFilter)) (def ^:private ReferencedQuerySnippet (ms/InstanceOfClass metabase.driver.common.parameters.ReferencedQuerySnippet)) (def ^:private ReferencedCardQuery (ms/InstanceOfClass metabase.driver.common.parameters.ReferencedCardQuery)) | |
Parse a tag by its | (defmulti ^:private parse-tag
{:arglists '([tag params])}
(fn [{tag-type :type} _]
(keyword tag-type))) |
(defmethod parse-tag :default
[{tag-type :type, :as tag} _]
(throw (ex-info (tru "Don''t know how to parse parameter of type {0}" (pr-str tag-type))
{:tag tag}))) | |
various schemas are used to check that various functions return things in expected formats | |
TAGS in this case are simple params like {{x}} that get replaced with a single value ("ABC" or 1) as opposed to a "FieldFilter" clause like FieldFilters Since 'FieldFilter' are considered their own | |
Schema for a valid single value for a param. | (def ^:private SingleValue [:or FieldFilter Date number? :string :boolean]) |
Schema for valid param value(s). Params can have one or more values. | (def ^:private ParsedParamValue
[:maybe
[:or
{:error/message "Valid param value(s)"}
[:= params/no-value]
SingleValue
[:sequential SingleValue]
:map]]) |
Given a template tag, returns a set of [:dimension [:template-tag {:id [:variable [:template-tag {:id Targeting template tags by ID is preferable (as of version 44) but targeting by name is supported for backwards compatibility. | (mu/defn ^:private tag-targets
[tag :- mbql.s/TemplateTag]
(let [target-type (case (:type tag)
:dimension :dimension
:variable)]
#{[target-type [:template-tag (:name tag)]]
[target-type [:template-tag {:id (:id tag)}]]})) |
Return params from the provided | (mu/defn ^:private tag-params
[tag :- mbql.s/TemplateTag
params :- [:maybe [:sequential mbql.s/Parameter]]]
(let [targets (tag-targets tag)]
(seq (for [param params
:when (contains? targets (:target param))]
param)))) |
FieldFilter Params (Field Filters) (e.g. WHERE {{x}}) | |
(defn- missing-required-param-exception [param-display-name]
(ex-info (tru "You''ll need to pick a value for ''{0}'' before this query can run."
param-display-name)
{:type qp.error-type/missing-required-parameter})) | |
(mu/defn ^:private field-filter->field-id :- ms/PositiveInt [field-filter] (second field-filter)) | |
Get parameter value(s) for a Field filter. Returns map if there is a normal single value, or a vector of maps for multiple values. | (mu/defn ^:private field-filter-value
[tag :- mbql.s/TemplateTag
params :- [:maybe [:sequential mbql.s/Parameter]]]
(let [matching-params (tag-params tag params)
tag-opts (:options tag)
normalize-params (fn [params]
;; remove `:target` which is no longer needed after this point, and add any tag options
(let [params (map #(cond-> (dissoc % :target)
(seq tag-opts) (assoc :options tag-opts))
params)]
(if (= (count params) 1)
(first params)
params)))
nil-value? (and (seq matching-params)
(every? (fn [param]
(nil? (:value param)))
matching-params))]
(cond
;; if we have matching parameter(s) that all have actual values, return those.
(and (seq matching-params) (every? :value matching-params))
(normalize-params matching-params)
;; If a FieldFilter has value=nil, return a [[params/no-value]]
;; so that this filter can be substituted with "1 = 1" regardless of whether or not this tag has default value
(and (not (:required tag)) nil-value?)
params/no-value
;; When a FieldFilter has value=nil and is required, throw an exception
(and (:required tag) nil-value?)
(throw (missing-required-param-exception (:display-name tag)))
;; otherwise, attempt to fall back to the default value specified as part of the template tag.
(some? (:default tag))
(cond-> {:type (:widget-type tag :dimension) ; widget-type is the actual type of the default value if set
:value (:default tag)}
tag-opts (assoc :options tag-opts))
;; if that doesn't exist, see if the matching parameters specified default values This can be the case if the
;; parameters came from a Dashboard -- Dashboard parameter mappings can specify their own defaults -- but we want
;; the defaults specified in the template tag to take precedence if both are specified
(and (seq matching-params) (every? :default matching-params))
(normalize-params matching-params)
;; otherwise there is no value for this Field filter ("dimension"), throw Exception if this param is required,
(:required tag)
(throw (missing-required-param-exception (:display-name tag)))
;; otherwise return [[params/no-value]] to signify that this filter can be substituted with "1 = 1"
:else
params/no-value))) |
(mu/defmethod parse-tag :dimension :- [:maybe FieldFilter]
[{field-filter :dimension, :as tag} :- mbql.s/TemplateTag
params :- [:maybe [:sequential mbql.s/Parameter]]]
(params/map->FieldFilter
{:field (let [field-id (field-filter->field-id field-filter)]
(or (lib.metadata/field (qp.store/metadata-provider) field-id)
(throw (ex-info (tru "Can''t find field with ID: {0}" field-id)
{:field-id field-id, :type qp.error-type/invalid-parameter}))))
:value (field-filter-value tag params)})) | |
(mu/defmethod parse-tag :card :- ReferencedCardQuery
[{:keys [card-id], :as tag} :- mbql.s/TemplateTag _params]
(when-not card-id
(throw (ex-info (tru "Invalid :card parameter: missing `:card-id`")
{:tag tag, :type qp.error-type/invalid-parameter})))
(let [card (lib.metadata.protocols/card (qp.store/metadata-provider) card-id)
persisted-info (when (:dataset card)
(:lib/persisted-info card))
query (or (:dataset-query card)
(throw (ex-info (tru "Card {0} not found." card-id)
{:card-id card-id, :tag tag, :type qp.error-type/invalid-parameter})))]
(try
(params/map->ReferencedCardQuery
(let [query (assoc query :info {:card-id card-id})]
(log/tracef "Compiling referenced query for Card %d\n%s" card-id (u/pprint-to-str query))
(merge {:card-id card-id}
(or (when (qp.persistence/can-substitute? card persisted-info)
{:query (qp.persistence/persisted-info-native-query
(u/the-id (lib.metadata/database (qp.store/metadata-provider)))
persisted-info)})
(qp/compile query)))))
(catch ExceptionInfo e
(throw (ex-info
(tru "The sub-query from referenced question #{0} failed with the following error: {1}"
(str card-id) (pr-str (.getMessage e)))
{:card-query-error? true
:card-id card-id
:tag tag
:type qp.error-type/invalid-parameter}
e)))))) | |
(mu/defmethod parse-tag :snippet :- ReferencedQuerySnippet
[{:keys [snippet-name snippet-id], :as tag} :- mbql.s/TemplateTag
_params]
(let [snippet-id (or snippet-id
(throw (ex-info (tru "Unable to resolve Snippet: missing `:snippet-id`")
{:tag tag, :type qp.error-type/invalid-parameter})))
snippet (or (t2/select-one NativeQuerySnippet :id snippet-id)
(throw (ex-info (tru "Snippet {0} {1} not found." snippet-id (pr-str snippet-name))
{:snippet-id snippet-id
:snippet-name snippet-name
:tag tag
:type qp.error-type/invalid-parameter})))]
(params/map->ReferencedQuerySnippet
{:snippet-id (:id snippet)
:content (:content snippet)}))) | |
Non-FieldFilter Params (e.g. WHERE x = {{x}}) | |
Get the value that should be used for a raw value (i.e., non-Field filter) template tag from | (mu/defn ^:private param-value-for-raw-value-tag
[tag :- mbql.s/TemplateTag
params :- [:maybe [:sequential mbql.s/Parameter]]]
(let [matching-param (when-let [matching-params (not-empty (tag-params tag params))]
;; double-check and make sure we didn't end up with multiple mappings or something crazy like that.
(when (> (count matching-params) 1)
(throw (ex-info (tru "Error: multiple values specified for parameter; non-Field Filter parameters can only have one value.")
{:type qp.error-type/invalid-parameter
:template-tag tag
:matching-parameters params})))
(first matching-params))
nil-value? (and matching-param
(nil? (:value matching-param)))]
;; But if the param is present in `params` and its value is nil, don't use the default.
;; If the param is not present in `params` use a default from either the tag or the Dashboard parameter.
;; If both the tag and Dashboard parameter specify a default value, prefer the default value from the tag.
(or (:value matching-param)
(when (and nil-value? (:required tag))
(throw (missing-required-param-exception (:display-name tag))))
(when (and nil-value? (not (:required tag)))
params/no-value)
(:default tag)
(:default matching-param)
(if (:required tag)
(throw (missing-required-param-exception (:display-name tag)))
params/no-value)))) |
(defmethod parse-tag :number [tag params] (param-value-for-raw-value-tag tag params)) | |
(defmethod parse-tag :text [tag params] (param-value-for-raw-value-tag tag params)) | |
(defmethod parse-tag :date [tag params] (param-value-for-raw-value-tag tag params)) | |
Parsing Values | |
(mu/defn ^:private parse-number :- number? "Parse a string like `1` or `2.0` into a valid number. Done mostly to keep people from passing in things that aren't numbers, like SQL identifiers." [s :- :string] (.parse (NumberFormat/getInstance) ^String s)) | |
(mu/defn ^:private value->number :- [:or number? [:sequential {:min 1} number?]]
"Parse a 'numeric' param value. Normally this returns an integer or floating-point number, but as a somewhat
undocumented feature it also accepts comma-separated lists of numbers. This was a side-effect of the old parameter
code that unquestioningly substituted any parameter passed in as a number directly into the SQL. This has long been
changed for security purposes (avoiding SQL injection), but since users have come to expect comma-separated numeric
values to work we'll allow that (with validation) and return a vector to be converted to a list in the native query."
[value]
(cond
;; already parsed
(number? value)
value
;; newer operators use vectors as their arguments even if there's only one
(vector? value)
(u/many-or-one (mapv value->number value))
;; if the value is a string, then split it by commas in the string. Usually there should be none.
;; Parse each part as a number.
(string? value)
(u/many-or-one (mapv parse-number (str/split value #","))))) | |
(mu/defn ^:private parse-value-for-field-type :- :any
"Do special parsing for value for a (presumably textual) FieldFilter (`:type` = `:dimension`) param (i.e., attempt
to parse it as appropriate based on the base type and semantic type of the Field associated with it). These are
special cases for handling types that do not have an associated parameter type (such as `date` or `number`), such as
UUID fields."
[effective-type :- ms/FieldType value]
(cond
(isa? effective-type :type/UUID)
(UUID/fromString value)
(isa? effective-type :type/Number)
(value->number value)
:else
value)) | |
(mu/defn ^:private update-filter-for-field-type :- ParsedParamValue
"Update a Field Filter with a textual, or sequence of textual, values. The base type and semantic type of the field
are used to determine what 'semantic' type interpretation is required (e.g. for UUID fields)."
[{field :field, {value :value} :value, :as field-filter} :- FieldFilter]
(let [effective-type ((some-fn :effective-type :base-type) field)
new-value (cond
(string? value)
(parse-value-for-field-type effective-type value)
(and (sequential? value)
(every? string? value))
(mapv (partial parse-value-for-field-type effective-type) value))]
(when (not= value new-value)
(log/tracef "update filter for base-type: %s value: %s -> %s"
(pr-str effective-type) (pr-str value) (pr-str new-value)))
(cond-> field-filter
new-value (assoc-in [:value :value] new-value)))) | |
(mu/defn ^:private parse-value-for-type :- ParsedParamValue
"Parse a `value` based on the type chosen for the param, such as `text` or `number`. (Depending on the type of param
created, `value` here might be a raw value or a map including information about the Field it references as well as a
value.) For numbers, dates, and the like, this will parse the string appropriately; for `text` parameters, this will
additionally attempt handle special cases based on the base type of the Field, for example, parsing params for UUID
base type Fields as UUIDs."
[param-type :- ::lib.schema.template-tag/type value]
(cond
(= value params/no-value)
value
(= param-type :number)
(value->number value)
(= param-type :date)
(params/map->Date {:s value})
;; Field Filters
(and (= param-type :dimension)
(= (get-in value [:value :type]) :number))
(update-in value [:value :value] value->number)
(sequential? value)
(mapv (partial parse-value-for-type param-type) value)
;; Field Filters with "special" base types
(and (= param-type :dimension)
(get-in value [:field :base-type]))
(update-filter-for-field-type value)
:else
value)) | |
(mu/defn ^:private value-for-tag :- ParsedParamValue
"Given a map `tag` (a value in the `:template-tags` dictionary) return the corresponding value from the `params`
sequence. The `value` is something that can be compiled to SQL via `->replacement-snippet-info`."
[tag :- mbql.s/TemplateTag
params :- [:maybe [:sequential mbql.s/Parameter]]]
(try
(parse-value-for-type (:type tag) (parse-tag tag params))
(catch Throwable e
(throw (ex-info (tru "Error determining value for parameter {0}: {1}"
(pr-str (:name tag))
(ex-message e))
{:tag tag
:type (or (:type (ex-data e)) qp.error-type/invalid-parameter)}
e))))) | |
(mu/defn query->params-map :- [:map-of ms/NonBlankString ParsedParamValue]
"Extract parameters info from `query`. Return a map of parameter name -> value.
(query->params-map some-inner-query)
->
{:checkin_date #t \"2019-09-19T23:30:42.233-07:00\"}"
[{tags :template-tags, params :parameters} :- :map]
(log/tracef "Building params map out of tags\n%s\nand params\n%s\n" (u/pprint-to-str tags) (u/pprint-to-str params))
(try
(into {} (for [[k tag] tags
:let [v (value-for-tag tag params)]]
(do
(log/tracef "Value for tag %s\n%s\n->\n%s" (pr-str k) (u/pprint-to-str tag) (u/pprint-to-str v))
[k v])))
(catch Throwable e
(throw (ex-info (tru "Error building query parameter map: {0}" (ex-message e))
{:type (or (:type (ex-data e)) qp.error-type/invalid-parameter)
:tags tags
:params params}
e))))) | |
(ns metabase.driver.ddl.interface (:require [clojure.string :as str] [metabase.driver :as driver] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.id :as lib.schema.id] [metabase.public-settings :as public-settings] [metabase.util.i18n :refer [tru]] [metabase.util.malli :as mu]) (:import (java.time Instant) (java.time.format DateTimeFormatter))) | |
(set! *warn-on-reflection* true) | |
(mu/defn schema-name :- ::lib.schema.common/non-blank-string
"Returns a schema name for persisting models. Needs the database to use the db id and the site-uuid to ensure that
multiple connections from multiple metabae remain distinct. The UUID will have the first character of each section taken.
(schema-name {:id 234} \"143dd8ce-e116-4c7f-8d6d-32e99eaefbbc\") -> \"metabase_cache_1e483_1\
[{:keys [id] :as _database} :- [:map [:id ::lib.schema.id/database]]
site-uuid-string :- ::lib.schema.common/non-blank-string]
(let [instance-string (apply str (map first (str/split site-uuid-string #"-")))]
(format "metabase_cache_%s_%s" instance-string id))) | |
Transform a lowercase string Table or Field name in a way appropriate for this dataset (e.g., This is actually ultimately used to format any name that comes back from [[metabase.test.data.sql/qualified-name-components]] -- so if you include the Database name there, it will get formatted by this as well. | (defmulti format-name
{:changelog-test/ignore true :added "0.44.0" :arglists '([driver table-or-field-name])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(defmethod format-name :default [_ table-or-field-name] table-or-field-name) | |
Verify that the source database is acceptable to persist. Returns a tuple of a boolean and Examples: - [true :persist.check/valid] - [false :persist.check/create-schema] - [false :persist.check/create-table] - [false :persist.check/read-table] - [false :persist.check/delete-table] | (defmulti check-can-persist
{:changelog-test/ignore true :added "0.44.0" :arglists '([database])}
(fn [database] (driver/dispatch-on-initialized-driver (:engine database)))
:hierarchy #'driver/hierarchy) |
The honeysql form that creates the persisted schema | (defn create-kv-table-honey-sql-form
[schema-name]
{:create-table [(keyword schema-name "cache_info") :if-not-exists]
:with-columns [[:key :text] [:value :text]]}) |
Version 1 of the values to go in the key/value table | (defn kv-table-values
[]
[{:key "settings-version"
:value "1"}
{:key "created-at"
;; "2023-03-29T14:01:27.871697Z"
:value (.format DateTimeFormatter/ISO_INSTANT (Instant/now))}
{:key "instance-uuid"
:value (public-settings/site-uuid)}
{:key "instance-name"
:value (public-settings/site-name)}]) |
The honeysql form that populates the persisted schema | (defn populate-kv-table-honey-sql-form
[schema-name]
{:insert-into [(keyword schema-name "cache_info")]
:values (kv-table-values)}) |
Human readable messages for different connection errors. | (defn error->message
[error schema]
(case error
:persist.check/create-schema (tru "Lack permissions to create {0} schema" schema)
:persist.check/create-table (tru "Lack permission to create table in schema {0}" schema)
:persist.check/read-table (tru "Lack permission to read table in schema {0}" schema)
:persist.check/delete-table (tru "Lack permission to delete table in schema {0}" schema))) |
Refresh a model in a datastore. A table is created and populated in the source datastore, not the application
database. Assumes that the destination schema is populated and permissions are correct. This should all be true
if | (defmulti refresh!
{:changelog-test/ignore true :added "0.44.0" :arglists '([driver database definition dataset-query])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Unpersist a persisted model. Responsible for removing the persisted table. | (defmulti unpersist!
{:changelog-test/ignore true :added "0.44.0" :arglists '([driver database persisted-info])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(ns metabase.driver.h2 (:require [clojure.math.combinatorics :as math.combo] [clojure.string :as str] [java-time.api :as t] [metabase.config :as config] [metabase.db.jdbc-protocols :as mdb.jdbc-protocols] [metabase.db.spec :as mdb.spec] [metabase.driver :as driver] [metabase.driver.common :as driver.common] [metabase.driver.h2.actions :as h2.actions] [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn] [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute] [metabase.driver.sql-jdbc.sync :as sql-jdbc.sync] [metabase.driver.sql.query-processor :as sql.qp] [metabase.lib.metadata :as lib.metadata] [metabase.plugins.classloader :as classloader] [metabase.query-processor.error-type :as qp.error-type] [metabase.query-processor.store :as qp.store] [metabase.util :as u] [metabase.util.honey-sql-2 :as h2x] [metabase.util.i18n :refer [deferred-tru tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.ssh :as ssh]) (:import (java.sql Clob ResultSet ResultSetMetaData) (java.time OffsetTime) (org.h2.command CommandInterface Parser) (org.h2.engine SessionLocal))) | |
(set! *warn-on-reflection* true) | |
method impls live in this namespace | (comment h2.actions/keep-me) |
(driver/register! :h2, :parent :sql-jdbc) | |
Whether to allow testing new H2 connections. Normally this is disabled, which effectively means you cannot create new H2 databases from the API, but this flag is here to disable that behavior for syncing existing databases, or when needed for tests. | (def ^:dynamic *allow-testing-h2-connections*
;; you can disable this flag with the env var below, please do not use it under any circumstances, it is only here so
;; existing e2e tests will run without us having to update a million tests. We should get rid of this and rework those
;; e2e tests to use SQLite ASAP.
(or (config/config-bool :mb-dangerous-unsafe-enable-testing-h2-connections-do-not-enable)
false)) |
this will prevent the H2 driver from showing up in the list of options when adding a new Database. | (defmethod driver/superseded-by :h2 [_driver] :deprecated) |
Returns value of private field. This function is used to bypass field protection to instantiate a low-level H2 Parser object in order to detect DDL statements in queries. | (defn- get-field
([obj field]
(.get (doto (.getDeclaredField (class obj) field)
(.setAccessible true))
obj))
([obj field or-else]
(try (get-field obj field)
(catch java.lang.NoSuchFieldException _e
;; when there are no fields: return or-else
or-else)))) |
+----------------------------------------------------------------------------------------------------------------+ | metabase.driver impls | +----------------------------------------------------------------------------------------------------------------+ | |
(doseq [[feature supported?] {:full-join false
:regex true
:percentile-aggregations false
:actions true
:actions/custom true
:datetime-diff true
:now true
:test/jvm-timezone-setting false
:uploads true
:index-info true}]
(defmethod driver/database-supports? [:h2 feature]
[_driver _feature _database]
supported?)) | |
(defmethod sql.qp/->honeysql [:h2 :regex-match-first] [driver [_ arg pattern]] [:regexp_substr (sql.qp/->honeysql driver arg) (sql.qp/->honeysql driver pattern)]) | |
(defmethod driver/connection-properties :h2
[_]
(->>
[{:name "db"
:display-name (tru "Connection String")
:helper-text (deferred-tru "The local path relative to where Metabase is running from. Your string should not include the .mv.db extension.")
:placeholder (str "file:/" (deferred-tru "Users/camsaul/bird_sightings/toucans"))
:required true}
driver.common/cloud-ip-address-info
driver.common/advanced-options-start
driver.common/default-advanced-options]
(map u/one-or-many)
(apply concat))) | |
Checks an h2 connection string for connection properties that could be malicious. Markers of this include semi-colons which allow for sql injection in org.h2.engine.Engine/openSession. The others are markers for languages like javascript and ruby that we want to suppress. | (defn- malicious-property-value
[s]
;; list of strings it looks for to compile scripts:
;; https://github.com/h2database/h2database/blob/master/h2/src/main/org/h2/util/SourceCompiler.java#L178-L187 we
;; can't use the static methods themselves since they expect to check the beginning of the string
(let [bad-markers [";"
"//javascript"
"#ruby"
"//groovy"
"@groovy"]
pred (apply some-fn (map (fn [marker] (fn [s] (str/includes? s marker)))
bad-markers))]
(pred s))) |
(defmethod driver/can-connect? :h2
[driver {:keys [db] :as details}]
(when-not *allow-testing-h2-connections*
(throw (ex-info (tru "H2 is not supported as a data warehouse") {:status-code 400})))
(when (string? db)
(let [connection-str (cond-> db
(not (str/includes? db "h2:")) (str/replace-first #"^" "h2:")
(not (str/includes? db "jdbc:")) (str/replace-first #"^" "jdbc:"))
connection-info (org.h2.engine.ConnectionInfo. connection-str nil nil nil)
properties (get-field connection-info "prop")
bad-props (into {} (keep (fn [[k v]] (when (malicious-property-value v) [k v])))
properties)]
(when (seq bad-props)
(throw (ex-info "Malicious keys detected" {:keys (keys bad-props)})))
;; keys are uppercased by h2 when parsed:
;; https://github.com/h2database/h2database/blob/master/h2/src/main/org/h2/engine/ConnectionInfo.java#L298
(when (contains? properties "INIT")
(throw (ex-info "INIT not allowed" {:keys ["INIT"]})))))
(sql-jdbc.conn/can-connect? driver details)) | |
(defmethod driver/db-start-of-week :h2 [_] :monday) | |
Explode a (connection-string->file+options "file:my-crazy-db;OPTION=100;OPTION_X=TRUE") -> ["file:my-crazy-db" {"OPTION" "100", "OPTION_X" "TRUE"}] TODO - it would be better not to put all the options in the connection string in the first place? | (defn- connection-string->file+options
[^String connection-string]
{:pre [(string? connection-string)]}
(let [[file & options] (str/split connection-string #";+")
options (into {} (for [option options]
(str/split option #"=")))]
[file options])) |
(defn- db-details->user [{:keys [db], :as details}]
{:pre [(string? db)]}
(or (some (partial get details) ["USER" :USER])
(let [[_ {:strs [USER]}] (connection-string->file+options db)]
USER))) | |
(defn- check-native-query-not-using-default-user [{query-type :type, :as query}]
(u/prog1 query
;; For :native queries check to make sure the DB in question has a (non-default) NAME property specified in the
;; connection string. We don't allow SQL execution on H2 databases for the default admin account for security
;; reasons
(when (= (keyword query-type) :native)
(let [{:keys [details]} (lib.metadata/database (qp.store/metadata-provider))
user (db-details->user details)]
(when (or (str/blank? user)
(= user "sa")) ; "sa" is the default USER
(throw
(ex-info (tru "Running SQL queries against H2 databases using the default (admin) database user is forbidden.")
{:type qp.error-type/db}))))))) | |
Returns an H2 Parser object for the given (H2) database ID | (defn- make-h2-parser
^Parser [h2-db-id]
(with-open [conn (.getConnection (sql-jdbc.execute/datasource-with-diagnostic-info! :h2 h2-db-id))]
;; The H2 Parser class is created from the H2 JDBC session, but these fields are not public
(let [session (-> conn (get-field "inner") (get-field "session"))]
;; Only SessionLocal represents a connection we can create a parser with. Remote sessions and other
;; session types are ignored.
(when (instance? SessionLocal session)
(Parser. session))))) |
(mu/defn ^:private classify-query :- [:maybe
[:map
[:command-types [:vector pos-int?]]
[:remaining-sql [:maybe :string]]]]
"Takes an h2 db id, and a query, returns the command-types from `query` and any remaining sql.
More info on command types here:
https://github.com/h2database/h2database/blob/master/h2/src/main/org/h2/command/CommandInterface.java
If the h2 parser cannot be built, returns `nil`.
- Each `command-type` corresponds to a value in org.h2.command.CommandInterface, and match the commands from `query` in order.
- `remaining-sql` is a nillable sql string that is unable to be classified without running preceding queries first.
Usually if `remaining-sql` exists we will deny the query."
[database query]
(when-let [h2-parser (make-h2-parser database)]
(try
(let [command (.prepareCommand h2-parser query)
first-command-type (.getCommandType command)
command-types (cond-> [first-command-type]
(not (instance? org.h2.command.CommandContainer command))
(into
(map #(.getType ^org.h2.command.Prepared %))
;; when there are no fields: return no commands
(get-field command "commands" [])))]
{:command-types command-types
;; when there is no remaining sql: return nil for remaining-sql
:remaining-sql (get-field command "remaining" nil)})
;; only valid queries can be classified.
(catch org.h2.message.DbException _
{:command-types [] :remaining-sql nil})))) | |
(defn- every-command-allowed-for-actions? [{:keys [command-types remaining-sql]}]
(let [cmd-type-nums command-types]
(boolean
;; Command types are organized with all DDL commands listed first, so all ddl commands are before ALTER_SEQUENCE.
;; see https://github.com/h2database/h2database/blob/master/h2/src/main/org/h2/command/CommandInterface.java#L297
;; This doesn't list all the possible commands, but it lists the most common and useful ones.
(and (every? #{CommandInterface/INSERT
CommandInterface/MERGE
CommandInterface/TRUNCATE_TABLE
CommandInterface/UPDATE
CommandInterface/DELETE
CommandInterface/CREATE_TABLE
CommandInterface/DROP_TABLE
CommandInterface/CREATE_SCHEMA
CommandInterface/DROP_SCHEMA
CommandInterface/ALTER_TABLE_RENAME
CommandInterface/ALTER_TABLE_ADD_COLUMN
CommandInterface/ALTER_TABLE_DROP_COLUMN
CommandInterface/ALTER_TABLE_ALTER_COLUMN_CHANGE_TYPE
CommandInterface/ALTER_TABLE_ALTER_COLUMN_NOT_NULL
CommandInterface/ALTER_TABLE_ALTER_COLUMN_DROP_NOT_NULL
CommandInterface/ALTER_TABLE_ALTER_COLUMN_RENAME
;; Read-only commands might not make sense for actions, but they are allowed
CommandInterface/SELECT ; includes SHOW, TABLE, VALUES
CommandInterface/EXPLAIN
CommandInterface/CALL} cmd-type-nums)
(nil? remaining-sql))))) | |
(defn- check-action-commands-allowed [{:keys [database] {:keys [query]} :native}]
(when query
(when-let [query-classification (classify-query database query)]
(when-not (every-command-allowed-for-actions? query-classification)
(throw (ex-info "DDL commands are not allowed to be used with H2."
{:classification query-classification})))))) | |
(defn- read-only-statements? [{:keys [command-types remaining-sql]}]
(let [cmd-type-nums command-types]
(boolean
(and (every? #{CommandInterface/SELECT ; includes SHOW, TABLE, VALUES
CommandInterface/EXPLAIN
CommandInterface/CALL} cmd-type-nums)
(nil? remaining-sql))))) | |
(defn- check-read-only-statements [{:keys [database] {:keys [query]} :native}]
(when query
(let [query-classification (classify-query database query)]
(when-not (read-only-statements? query-classification)
(throw (ex-info "Only SELECT statements are allowed in a native query."
{:classification query-classification})))))) | |
(defmethod driver/execute-reducible-query :h2 [driver query chans respond] (check-native-query-not-using-default-user query) (check-read-only-statements query) ((get-method driver/execute-reducible-query :sql-jdbc) driver query chans respond)) | |
(defmethod driver/execute-write-query! :h2 [driver query] (check-native-query-not-using-default-user query) (check-action-commands-allowed query) ((get-method driver/execute-write-query! :sql-jdbc) driver query)) | |
(defmethod sql.qp/add-interval-honeysql-form :h2
[driver hsql-form amount unit]
(cond
(= unit :quarter)
(recur driver hsql-form (h2x/* amount 3) :month)
;; H2 only supports long ints in the `dateadd` amount field; since we want to support fractional seconds (at least
;; for application DB purposes) convert to `:millisecond`
(and (= unit :second)
(not (zero? (rem amount 1))))
(recur driver hsql-form (* amount 1000.0) :millisecond)
:else
[:dateadd
(h2x/literal unit)
(h2x/cast :long (if (number? amount)
(sql.qp/inline-num amount)
amount))
(h2x/cast :datetime hsql-form)])) | |
(defmethod driver/humanize-connection-error-message :h2
[_ message]
(condp re-matches message
#"^A file path that is implicitly relative to the current working directory is not allowed in the database URL .*$"
:implicitly-relative-db-file-path
#"^Database .* not found, .*$"
:db-file-not-found
#"^Wrong user name or password .*$"
:username-or-password-incorrect
message)) | |
(defmethod driver/db-default-timezone :h2 [_driver _database] ;; Based on this answer https://stackoverflow.com/a/18883531 and further experiments, h2 uses timezone of the jvm ;; where the driver is loaded. (System/getProperty "user.timezone")) | |
+----------------------------------------------------------------------------------------------------------------+ | metabase.driver.sql impls | +----------------------------------------------------------------------------------------------------------------+ | |
(defmethod sql.qp/current-datetime-honeysql-form :h2 [_] (h2x/with-database-type-info :%now :TIMESTAMP)) | |
(defn- add-to-1970 [expr unit-str] [:timestampadd (h2x/literal unit-str) expr [:raw "timestamp '1970-01-01T00:00:00Z'"]]) | |
(defmethod sql.qp/unix-timestamp->honeysql [:h2 :seconds] [_ _ expr] (add-to-1970 expr "second")) | |
(defmethod sql.qp/unix-timestamp->honeysql [:h2 :milliseconds] [_ _ expr] (add-to-1970 expr "millisecond")) | |
(defmethod sql.qp/unix-timestamp->honeysql [:h2 :microseconds] [_ _ expr] (add-to-1970 expr "microsecond")) | |
(defmethod sql.qp/cast-temporal-string [:h2 :Coercion/YYYYMMDDHHMMSSString->Temporal] [_driver _coercion-strategy expr] [:parsedatetime expr (h2x/literal "yyyyMMddHHmmss")]) | |
(defmethod sql.qp/cast-temporal-byte [:h2 :Coercion/YYYYMMDDHHMMSSBytes->Temporal]
[driver _coercion-strategy expr]
(sql.qp/cast-temporal-string driver :Coercion/YYYYMMDDHHMMSSString->Temporal
[:utf8tostring expr])) | |
H2 v2 added date_trunc and extract, so we can borrow the Postgres implementation | (defn- date-trunc [unit expr] [:date_trunc (h2x/literal unit) expr]) (defn- extract [unit expr] [::h2x/extract unit expr]) |
(def ^:private extract-integer (comp h2x/->integer extract)) | |
(defmethod sql.qp/date [:h2 :default] [_ _ expr] expr) (defmethod sql.qp/date [:h2 :second-of-minute] [_ _ expr] (extract-integer :second expr)) (defmethod sql.qp/date [:h2 :minute] [_ _ expr] (date-trunc :minute expr)) (defmethod sql.qp/date [:h2 :minute-of-hour] [_ _ expr] (extract-integer :minute expr)) (defmethod sql.qp/date [:h2 :hour] [_ _ expr] (date-trunc :hour expr)) (defmethod sql.qp/date [:h2 :hour-of-day] [_ _ expr] (extract-integer :hour expr)) (defmethod sql.qp/date [:h2 :day] [_ _ expr] (h2x/->date expr)) (defmethod sql.qp/date [:h2 :day-of-month] [_ _ expr] (extract-integer :day expr)) (defmethod sql.qp/date [:h2 :day-of-year] [_ _ expr] (extract-integer :doy expr)) (defmethod sql.qp/date [:h2 :month] [_ _ expr] (date-trunc :month expr)) (defmethod sql.qp/date [:h2 :month-of-year] [_ _ expr] (extract-integer :month expr)) (defmethod sql.qp/date [:h2 :quarter] [_ _ expr] (date-trunc :quarter expr)) (defmethod sql.qp/date [:h2 :quarter-of-year] [_ _ expr] (extract-integer :quarter expr)) (defmethod sql.qp/date [:h2 :year] [_ _ expr] (date-trunc :year expr)) (defmethod sql.qp/date [:h2 :year-of-era] [_ _ expr] (extract-integer :year expr)) | |
(defmethod sql.qp/date [:h2 :day-of-week] [_ _ expr] (sql.qp/adjust-day-of-week :h2 (extract :iso_day_of_week expr))) | |
(defmethod sql.qp/date [:h2 :week]
[_ _ expr]
(sql.qp/add-interval-honeysql-form :h2 (sql.qp/date :h2 :day expr)
(h2x/- 1 (sql.qp/date :h2 :day-of-week expr))
:day)) | |
(defmethod sql.qp/date [:h2 :week-of-year-iso] [_ _ expr] (extract :iso_week expr)) | |
(defmethod sql.qp/->honeysql [:h2 :log] [driver [_ field]] [:log10 (sql.qp/->honeysql driver field)]) | |
Like H2's | (defn- datediff [unit x y] [:datediff [:raw (name unit)] (h2x/->timestamp x) (h2x/->timestamp y)]) |
Like H2's extract but accounts for timestamps with time zones. | (defn- time-zoned-extract [unit x] (extract unit (h2x/->timestamp x))) |
(defmethod sql.qp/datetime-diff [:h2 :year] [driver _unit x y] (h2x// (sql.qp/datetime-diff driver :month x y) 12)) (defmethod sql.qp/datetime-diff [:h2 :quarter] [driver _unit x y] (h2x// (sql.qp/datetime-diff driver :month x y) 3)) | |
(defmethod sql.qp/datetime-diff [:h2 :month]
[_driver _unit x y]
(h2x/+ (datediff :month x y)
;; datediff counts month boundaries not whole months, so we need to adjust
;; if x<y but x>y in the month calendar then subtract one month
;; if x>y but x<y in the month calendar then add one month
[:case
[:and [:< x y] [:> (time-zoned-extract :day x) (time-zoned-extract :day y)]]
-1
[:and [:> x y] [:< (time-zoned-extract :day x) (time-zoned-extract :day y)]]
1
:else
0])) | |
(defmethod sql.qp/datetime-diff [:h2 :week] [_driver _unit x y] (h2x// (datediff :day x y) 7)) (defmethod sql.qp/datetime-diff [:h2 :day] [_driver _unit x y] (datediff :day x y)) (defmethod sql.qp/datetime-diff [:h2 :hour] [_driver _unit x y] (h2x// (datediff :millisecond x y) 3600000)) (defmethod sql.qp/datetime-diff [:h2 :minute] [_driver _unit x y] (datediff :minute x y)) (defmethod sql.qp/datetime-diff [:h2 :second] [_driver _unit x y] (datediff :second x y)) | |
+----------------------------------------------------------------------------------------------------------------+ | metabase.driver.sql-jdbc impls | +----------------------------------------------------------------------------------------------------------------+ | |
Datatype grammar adapted from BNF at https://h2database.com/html/datatypes.html | |
Expands BNF-like grammar to all possible data types | (defn- expand-grammar
[grammar]
(cond
(set? grammar) (mapcat expand-grammar grammar)
(list? grammar) (map (partial str/join " ")
(apply math.combo/cartesian-product
(map expand-grammar grammar)))
:else [grammar])) |
(def ^:private base-type->db-type-grammar
'{:type/Boolean #{BOOLEAN}
:type/Integer #{TINYINT SMALLINT INTEGER INT}
:type/BigInteger #{BIGINT}
:type/Decimal #{NUMERIC DECIMAL DEC}
:type/Float #{REAL FLOAT "DOUBLE PRECISION" DECFLOAT}
:type/Text #{CHARACTER
CHAR
(NATIONAL #{CHARACTER CHAR})
NCHAR
(#{CHARACTER CHAR} VARYING)
VARCHAR
(#{(NATIONAL #{CHARACTER CHAR}) NCHAR} VARYING)
VARCHAR_CASESENSITIVE
(#{CHARACTER CHAR} LARGE OBJECT)
CLOB
(#{NATIONAL CHARACTER NCHAR} LARGE OBJECT)
NCLOB
UUID}
:type/* #{ARRAY
BINARY
"BINARY VARYING"
VARBINARY
"BINARY LARGE OBJECT"
BLOB
GEOMETRY
IMAGE}
:type/Date #{DATE}
:type/DateTime #{TIMESTAMP}
:type/Time #{TIME "TIME WITHOUT TIME ZONE"}
:type/TimeWithLocalTZ #{"TIME WITH TIME ZONE"}
:type/DateTimeWithLocalTZ #{"TIMESTAMP WITH TIME ZONE"}}) | |
(def ^:private db-type->base-type
(into {}
(for [[base-type grammar] base-type->db-type-grammar
db-type (expand-grammar grammar)]
[(keyword db-type) base-type]))) | |
(defmethod sql-jdbc.sync/database-type->base-type :h2 [_ database-type] (db-type->base-type database-type)) | |
These functions for exploding / imploding the options in the connection strings are here so we can override shady options users might try to put in their connection string, like INIT=... | |
Implode the results of | (defn- file+options->connection-string
[file options]
(apply str file (for [[k v] options]
(str ";" k "=" v)))) |
Add Metabase Security Settings™ to this | (defn- connection-string-set-safe-options
[connection-string]
{:pre [(string? connection-string)]}
(let [[file options] (connection-string->file+options connection-string)]
(file+options->connection-string file (merge
(->> options
;; Remove INIT=... from options for security reasons (Metaboat #165)
;; http://h2database.com/html/features.html#execute_sql_on_connection
(remove (fn [[k _]] (= (u/lower-case-en k) "init")))
(into {}))
{"IFEXISTS" "TRUE"})))) |
(defmethod sql-jdbc.conn/connection-details->spec :h2
[_ details]
{:pre [(map? details)]}
(mdb.spec/spec :h2 (cond-> details
(string? (:db details)) (update :db connection-string-set-safe-options)))) | |
(defmethod sql-jdbc.sync/active-tables :h2 [& args] (apply sql-jdbc.sync/post-filtered-active-tables args)) | |
(defmethod sql-jdbc.sync/excluded-schemas :h2
[_]
#{"INFORMATION_SCHEMA"}) | |
(defmethod sql-jdbc.execute/do-with-connection-with-options :h2
[driver db-or-id-or-spec {:keys [write?], :as options} f]
;; h2 doesn't support setting timezones, or changing the transaction level without admin perms, so we can skip those
;; steps that are in the default impl
(sql-jdbc.execute/do-with-resolved-connection
driver
db-or-id-or-spec
(dissoc options :session-timezone)
(fn [^java.sql.Connection conn]
(when-not (sql-jdbc.execute/recursive-connection?)
;; in H2, setting readOnly to true doesn't prevent writes
;; see https://github.com/h2database/h2database/issues/1163
(.setReadOnly conn (not write?)))
(f conn)))) | |
de-CLOB any CLOB values that come back | (defmethod sql-jdbc.execute/read-column-thunk :h2
[_ ^ResultSet rs ^ResultSetMetaData rsmeta ^Integer i]
(let [classname (some-> (.getColumnClassName rsmeta i)
(Class/forName true (classloader/the-classloader)))]
(if (isa? classname Clob)
(fn []
(mdb.jdbc-protocols/clob->str (.getObject rs i)))
(fn []
(.getObject rs i))))) |
(defmethod sql-jdbc.execute/set-parameter [:h2 OffsetTime]
[driver prepared-statement i t]
(let [local-time (t/local-time (t/with-offset-same-instant t (t/zone-offset 0)))]
(sql-jdbc.execute/set-parameter driver prepared-statement i local-time))) | |
(defmethod driver/incorporate-ssh-tunnel-details :h2
[_ db-details]
(if (and (:tunnel-enabled db-details) (ssh/ssh-tunnel-open? db-details))
(if (and (:db db-details) (str/starts-with? (:db db-details) "tcp://"))
(let [details (ssh/include-ssh-tunnel! db-details)
db (:db details)]
(assoc details :db (str/replace-first db (str (:orig-port details)) (str (:tunnel-entrance-port details)))))
(do (log/error (tru "SSH tunnel can only be established for H2 connections using the TCP protocol"))
db-details))
db-details)) | |
(defmethod driver/upload-type->database-type :h2
[_driver upload-type]
(case upload-type
:metabase.upload/varchar-255 [:varchar]
:metabase.upload/text [:varchar]
:metabase.upload/int [:bigint]
:metabase.upload/auto-incrementing-int-pk [:bigint :generated-always :as :identity :primary-key]
:metabase.upload/float [(keyword "DOUBLE PRECISION")]
:metabase.upload/boolean [:boolean]
:metabase.upload/date [:date]
:metabase.upload/datetime [:timestamp]
:metabase.upload/offset-datetime [:timestamp-with-time-zone])) | |
(defmethod driver/table-name-length-limit :h2 [_driver] ;; http://www.h2database.com/html/advanced.html#limits_limitations 256) | |
Method impls for [[metabase.driver.sql-jdbc.actions]] for | (ns metabase.driver.h2.actions (:require [clojure.java.jdbc :as jdbc] [clojure.string :as str] [metabase.actions.error :as actions.error] [metabase.driver.sql-jdbc.actions :as sql-jdbc.actions] [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn] [metabase.util :as u] [metabase.util.i18n :refer [tru deferred-trun]] [metabase.util.log :as log])) |
(defmethod sql-jdbc.actions/base-type->sql-type-map :h2
[_driver]
{:type/BigInteger "BIGINT"
:type/Boolean "BOOL"
:type/Date "DATE"
:type/DateTime "DATETIME"
:type/DateTimeWithTZ "TIMESTAMP WITH TIME ZONE"
:type/Decimal "DECIMAL"
:type/Float "FLOAT"
:type/Integer "INTEGER"
:type/Text "VARCHAR"
:type/Time "TIME"}) | |
H2 doesn't need to do anything special with nested transactions; the original transaction can proceed even if some specific statement errored. | (defmethod sql-jdbc.actions/do-nested-transaction :h2 [_driver _conn thunk] (thunk)) |
Get the name of identifier from JDBC error message. An identifier can contains quote and full schema, database, table , etc. This formats so that we get only the identifer name with quote removed. (db-identifier->name "PUBLIC.TABLE" ) => "TABLE" | (defn- db-identifier->name
[s]
(-> s
(str/replace #"\"" "")
(str/split #"\.")
last)) |
Given a constraint with | (defn- constraint->column-names
[database table-name constraint-name]
(let [jdbc-spec (sql-jdbc.conn/db->pooled-connection-spec (u/the-id database))
sql-args ["SELECT C.TABLE_CATALOG, C.TABLE_SCHEMA, K.COLUMN_NAME
FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS C
JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE K ON C.CONSTRAINT_NAME = K.CONSTRAINT_NAME
WHERE C.INDEX_NAME = ? AND C.TABLE_NAME = ?"
constraint-name table-name]]
(first
(reduce
(fn [[columns catalog schema] {:keys [table_catalog table_schema column_name]}]
(if (and (or (nil? catalog) (= table_catalog catalog))
(or (nil? schema) (= table_schema schema)))
[(conj columns column_name) table_catalog table_schema]
(do (log/warnf "Ambiguous catalog/schema for constraint %s in table %s"
constraint-name table-name)
(reduced nil))))
[[] nil nil]
(jdbc/reducible-query jdbc-spec sql-args {:identifers identity, :transaction? false}))))) |
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:h2 actions.error/violate-not-null-constraint]
[_driver error-type _database _action-type error-message]
(when-let [[_ column]
(re-find #"NULL not allowed for column \"([^\"]+)\"" error-message)]
{:type error-type
:message (tru "{0} must have values." (str/capitalize column))
:errors {column (tru "You must provide a value.")}})) | |
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:h2 actions.error/violate-unique-constraint]
[_driver error-type database _action-type error-message]
(when-let [[_match constraint-name table]
(re-find #"Unique index or primary key violation: \"[^.]+.(.+?) ON [^.]+.\"\"(.+?)\"\"" error-message)]
(let [columns (constraint->column-names database table constraint-name)]
{:type error-type
:message (tru "{0} already {1}." (u/build-sentence (map str/capitalize columns) :stop? false) (deferred-trun "exists" "exist" (count columns)))
:errors (reduce (fn [acc col]
(assoc acc col (tru "This {0} value already exists." (str/capitalize col))))
{}
columns)}))) | |
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:h2 actions.error/violate-foreign-key-constraint]
[_driver error-type _database action-type error-message]
(when-let [[_match column]
(re-find #"Referential integrity constraint violation: \"[^\:]+: [^\s]+ FOREIGN KEY\(([^\s]+)\)" error-message)]
(let [column (db-identifier->name column)]
(merge {:type error-type}
(case action-type
:row/create
{:message (tru "Unable to create a new record.")
:errors {column (tru "This {0} does not exist." (str/capitalize column))}}
:row/delete
{:message (tru "Other tables rely on this row so it cannot be deleted.")
:errors {}}
:row/update
{:message (tru "Unable to update the record.")
:errors {column (tru "This {0} does not exist." (str/capitalize column))}}))))) | |
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:h2 actions.error/incorrect-value-type]
[_driver error-type _database _action-type error-message]
(when-let [[_ _expected-type _value]
(re-find #"Data conversion error converting .*" error-message)]
{:type error-type
:message (tru "Some of your values aren’t of the correct type for the database.")
:errors {}})) | |
Internal implementation functions for [[metabase.driver]]. These functions live in a separate namespace to reduce the clutter in [[metabase.driver]] itself. | (ns metabase.driver.impl (:require [metabase.lib.util :as lib.util] [metabase.plugins.classloader :as classloader] [metabase.util :as u] [metabase.util.i18n :refer [trs tru]] [metabase.util.log :as log] [schema.core :as s]) (:import (java.util.concurrent.locks ReentrantReadWriteLock))) |
(set! *warn-on-reflection* true) | |
--------------------------------------------------- Hierarchy ---------------------------------------------------- | |
Driver hierarchy. Used by driver multimethods for dispatch. Add new drivers with | (defonce hierarchy (make-hierarchy)) |
To find out whether a driver has been registered, we need to wait until any current driver-loading operations have finished. Otherwise we can get a "false positive" -- see #13114. To see whether a driver is registered, we only need to obtain a read lock -- multiple threads can have these at once, and they only block if a write lock is held or if a thread is waiting for one (see dox for [[ReentrantReadWriteLock]] for more details.) If we're currently in the process of loading a driver namespace, obtain the write lock which will prevent other threads from obtaining read locks until it finishes. | (defonce ^:private ^ReentrantReadWriteLock load-driver-lock (ReentrantReadWriteLock.)) |
(defmacro ^:private with-load-driver-read-lock [& body]
`(try
(.. load-driver-lock readLock lock)
~@body
(finally
(.. load-driver-lock readLock unlock)))) | |
(defmacro ^:private with-load-driver-write-lock [& body]
`(try
(.. load-driver-lock writeLock lock)
~@body
(finally
(.. load-driver-lock writeLock unlock)))) | |
Is | (defn registered?
[driver]
(with-load-driver-read-lock
(isa? hierarchy (keyword driver) :metabase.driver/driver))) |
Is | (defn concrete? [driver] (isa? hierarchy (keyword driver) ::concrete)) |
Is | (defn abstract? [driver] (not (concrete? driver))) |
-------------------------------------------- Loading Driver Namespace -------------------------------------------- | |
(s/defn ^:private driver->expected-namespace [driver :- s/Keyword]
(symbol
(or (namespace driver)
(str "metabase.driver." (name driver))))) | |
| (defn- require-driver-ns
[driver & require-options]
(let [expected-ns (driver->expected-namespace driver)]
(log/debug
(trs "Loading driver {0} {1}" (u/format-color 'blue driver) (apply list 'require expected-ns require-options)))
(try
(apply classloader/require expected-ns require-options)
(catch Throwable e
(log/error e (tru "Error loading driver namespace"))
(throw (Exception. (tru "Could not load {0} driver." driver) e)))))) |
Load the expected namespace for a You should almost never need to do this directly; it is handled automatically when dispatching on a driver and by
| (defn load-driver-namespace-if-needed!
[driver]
(when-not *compile-files*
(when-not (registered? driver)
(with-load-driver-write-lock
;; driver may have become registered while we were waiting for the lock, check again to be sure
(when-not (registered? driver)
(u/profile (trs "Load driver {0}" driver)
(require-driver-ns driver)
;; ok, hopefully it was registered now. If not, try again, but reload the entire driver namespace
(when-not (registered? driver)
(require-driver-ns driver :reload)
;; if *still* not registered, throw an Exception
(when-not (registered? driver)
(throw (Exception. (tru "Driver not registered after loading: {0}" driver))))))))))) |
-------------------------------------------------- Registration -------------------------------------------------- | |
Check to make sure we're not trying to change the abstractness of an already registered driver | (defn check-abstractness-hasnt-changed
[driver new-abstract?]
(when (registered? driver)
(let [old-abstract? (boolean (abstract? driver))
new-abstract? (boolean new-abstract?)]
(when (not= old-abstract? new-abstract?)
(throw (Exception. (tru "Error: attempting to change {0} property `:abstract?` from {1} to {2}."
driver old-abstract? new-abstract?))))))) |
Register a driver. (register! :sql, :abstract? true) (register! :postgres, :parent :sql-jdbc) Valid options are: `:parent` (default = none)Parent driver(s) to derive from. Drivers inherit method implementations from their parents similar to the way inheritance works in OOP. Specify multiple direct parents by passing a collection of parents. You can add additional parents to a driver using [[metabase.driver/add-parent!]]; this is how test extensions are implemented. `:abstract?` (default = false)Is this an abstract driver (i.e. should we hide it in the admin interface, and disallow running queries with it)? Note that because concreteness is implemented as part of our keyword hierarchy it is not currently possible to
create an abstract driver with a concrete driver as its parent, since it would still ultimately derive from
| (defn register!
[driver & {:keys [parent abstract?]}]
{:pre [(keyword? driver)]}
;; no-op during compilation.
(when-not *compile-files*
(let [parents (filter some? (u/one-or-many parent))]
;; load parents as needed; if this is an abstract driver make sure parents aren't concrete
(doseq [parent parents]
(load-driver-namespace-if-needed! parent))
(when abstract?
(doseq [parent parents
:when (concrete? parent)]
(throw (ex-info (trs "Abstract drivers cannot derive from concrete parent drivers.")
{:driver driver, :parent parent}))))
;; validate that the registration isn't stomping on things
(check-abstractness-hasnt-changed driver abstract?)
;; ok, if that was successful we can derive the driver from `:metabase.driver/driver`/`::concrete` and parent(s)
(let [derive! (partial alter-var-root #'hierarchy derive driver)]
(derive! :metabase.driver/driver)
(when-not abstract?
(derive! ::concrete))
(doseq [parent parents]
(derive! parent)))
;; ok, log our great success
(log/info
(u/format-color 'blue
(if (metabase.driver.impl/abstract? driver)
(trs "Registered abstract driver {0}" driver)
(trs "Registered driver {0}" driver)))
(if (seq parents)
(trs "(parents: {0})" (vec parents))
"")
(u/emoji "🚚"))))) |
------------------------------------------------- Initialization ------------------------------------------------- | |
We'll keep track of which drivers are initialized using a set rather than adding a special key to the hierarchy or something like that -- we don't want child drivers to inherit initialized status from their ancestors | (defonce ^:private initialized-drivers
;; For the purposes of this exercise the special keywords used in the hierarchy should always be assumed to be
;; initialized so we don't try to call initialize on them, which of course would try to load their namespaces when
;; dispatching off `the-driver`; that would fail, so don't try it
(atom #{:metabase.driver/driver ::concrete})) |
Has | (defn initialized? [driver] (@initialized-drivers driver)) |
(defonce ^:private initialization-lock (Object.)) | |
Initialize a driver by calling executing | (defn initialize-if-needed!
[driver init-fn]
;; no-op during compilation
(when-not *compile-files*
;; first, initialize parents as needed
(doseq [parent (parents hierarchy driver)]
(initialize-if-needed! parent init-fn))
(when-not (initialized? driver)
;; if the driver is not yet initialized, acquire an exclusive lock for THIS THREAD to perform initialization to
;; make sure no other thread tries to initialize it at the same time
(locking initialization-lock
;; and once we acquire the lock, check one more time to make sure the driver didn't get initialized by
;; whatever thread(s) we were waiting on.
(when-not (initialized? driver)
(log/info (u/format-color 'yellow (trs "Initializing driver {0}..." driver)))
(log/debug (trs "Reason:") (u/pprint-to-str 'blue (drop 5 (u/filtered-stacktrace (Thread/currentThread)))))
(init-fn driver)
(swap! initialized-drivers conj driver)))))) |
----------------------------------------------- [[truncate-alias]] ----------------------------------------------- | |
Default length to truncate column and table identifiers to for the default implementation of [[metabase.driver/escape-alias]]. | (def default-alias-max-length-bytes ;; Postgres' limit is 63 bytes -- see ;; https://www.postgresql.org/docs/current/sql-syntax-lexical.html#SQL-SYNTAX-IDENTIFIERS so we'll limit the ;; identifiers we generate to 60 bytes so we have room to add `_2` and stuff without drama 60) |
Truncate string (truncate-alias "somereallylongstring" 15) ; -> "somer_8e0f9bc2" (truncate-alias "somereallylongstring2" 15) ; -> "somer2a3c73eb" | (defn truncate-alias (^String [s] (truncate-alias s default-alias-max-length-bytes)) (^String [^String s max-length-bytes] (lib.util/truncate-alias s max-length-bytes))) |
MySQL driver. Builds off of the SQL-JDBC driver. | (ns metabase.driver.mysql (:require [clojure.java.io :as jio] [clojure.java.jdbc :as jdbc] [clojure.set :as set] [clojure.string :as str] [clojure.walk :as walk] [honey.sql :as sql] [java-time.api :as t] [medley.core :as m] [metabase.config :as config] [metabase.db.spec :as mdb.spec] [metabase.driver :as driver] [metabase.driver.common :as driver.common] [metabase.driver.mysql.actions :as mysql.actions] [metabase.driver.mysql.ddl :as mysql.ddl] [metabase.driver.sql-jdbc.common :as sql-jdbc.common] [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn] [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute] [metabase.driver.sql-jdbc.sync :as sql-jdbc.sync] [metabase.driver.sql.query-processor :as sql.qp] [metabase.driver.sql.query-processor.util :as sql.qp.u] [metabase.driver.sql.util :as sql.u] [metabase.driver.sql.util.unprepare :as unprepare] [metabase.lib.field :as lib.field] [metabase.lib.metadata :as lib.metadata] [metabase.query-processor.store :as qp.store] [metabase.query-processor.timezone :as qp.timezone] [metabase.query-processor.util.add-alias-info :as add] [metabase.upload :as upload] [metabase.util :as u] [metabase.util.honey-sql-2 :as h2x] [metabase.util.i18n :refer [deferred-tru trs]] [metabase.util.log :as log]) (:import (java.io File) (java.sql DatabaseMetaData ResultSet ResultSetMetaData Types) (java.time LocalDateTime OffsetDateTime OffsetTime ZonedDateTime ZoneOffset) (java.time.format DateTimeFormatter))) |
(set! *warn-on-reflection* true) | |
(comment ;; method impls live in these namespaces. mysql.actions/keep-me mysql.ddl/keep-me) | |
(driver/register! :mysql, :parent :sql-jdbc) | |
(def ^:private ^:const min-supported-mysql-version 5.7) (def ^:private ^:const min-supported-mariadb-version 10.2) | |
(defmethod driver/display-name :mysql [_] "MySQL") | |
(doseq [[feature supported?] {:persist-models true
:convert-timezone true
:datetime-diff true
:now true
:regex false
:percentile-aggregations false
:full-join false
:uploads true
:schemas false
;; MySQL LIKE clauses are case-sensitive or not based on whether the collation of the server and the columns
;; themselves. Since this isn't something we can really change in the query itself don't present the option to the
;; users in the UI
:case-sensitivity-string-filter-options false
:index-info true}]
(defmethod driver/database-supports? [:mysql feature] [_driver _feature _db] supported?)) | |
This is a bit of a lie since the JSON type was introduced for MySQL since 5.7.8.
And MariaDB doesn't have the JSON type at all, though | (defmethod driver/database-supports? [:mysql :nested-field-columns] [_driver _feat db] (driver.common/json-unfolding-default db)) |
(doseq [feature [:actions :actions/custom]]
(defmethod driver/database-supports? [:mysql feature]
[driver _feat _db]
;; Only supported for MySQL right now. Revise when a child driver is added.
(= driver :mysql))) | |
Returns true if the database is MariaDB. Assumes the database has been synced so | (defn mariadb? [database] (-> database :dbms_version :flavor (= "MariaDB"))) |
(defmethod driver/database-supports? [:mysql :table-privileges] [driver _feat db] (and (= driver :mysql) (not (mariadb? db)))) | |
+----------------------------------------------------------------------------------------------------------------+ | metabase.driver impls | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- db-version [^DatabaseMetaData metadata] (Double/parseDouble (format "%d.%d" (.getDatabaseMajorVersion metadata) (.getDatabaseMinorVersion metadata)))) | |
(defn- unsupported-version? [^DatabaseMetaData metadata]
(let [mariadb? (= (.getDatabaseProductName metadata) "MariaDB")]
(< (db-version metadata)
(if mariadb?
min-supported-mariadb-version
min-supported-mysql-version)))) | |
(defn- warn-on-unsupported-versions [driver details]
(sql-jdbc.conn/with-connection-spec-for-testing-connection [jdbc-spec [driver details]]
(sql-jdbc.execute/do-with-connection-with-options
driver
jdbc-spec
nil
(fn [^java.sql.Connection conn]
(when (unsupported-version? (.getMetaData conn))
(log/warn
(u/format-color 'red
(str
"\n\n********************************************************************************\n"
(trs "WARNING: Metabase only officially supports MySQL {0}/MariaDB {1} and above."
min-supported-mysql-version
min-supported-mariadb-version)
"\n"
(trs "All Metabase features may not work properly when using an unsupported version.")
"\n********************************************************************************\n")))))))) | |
(defmethod driver/can-connect? :mysql
[driver details]
;; delegate to parent method to check whether we can connect; if so, check if it's an unsupported version and issue
;; a warning if it is
(when ((get-method driver/can-connect? :sql-jdbc) driver details)
(warn-on-unsupported-versions driver details)
true)) | |
Server SSL certificate chain, in PEM format. | (def default-ssl-cert-details
{:name "ssl-cert"
:display-name (deferred-tru "Server SSL certificate chain")
:placeholder ""
:visible-if {"ssl" true}}) |
(defmethod driver/connection-properties :mysql
[_]
(->>
[driver.common/default-host-details
(assoc driver.common/default-port-details :placeholder 3306)
driver.common/default-dbname-details
driver.common/default-user-details
driver.common/default-password-details
driver.common/cloud-ip-address-info
driver.common/default-ssl-details
default-ssl-cert-details
driver.common/ssh-tunnel-preferences
driver.common/advanced-options-start
driver.common/json-unfolding
(assoc driver.common/additional-options
:placeholder "tinyInt1isBit=false")
driver.common/default-advanced-options]
(map u/one-or-many)
(apply concat))) | |
(defmethod sql.qp/add-interval-honeysql-form :mysql
[driver hsql-form amount unit]
;; MySQL doesn't support `:millisecond` as an option, but does support fractional seconds
(if (= unit :millisecond)
(recur driver hsql-form (/ amount 1000.0) :second)
[:date_add hsql-form [:raw (format "INTERVAL %s %s" amount (name unit))]])) | |
now() returns current timestamp in seconds resolution; now(6) returns it in nanosecond resolution | (defmethod sql.qp/current-datetime-honeysql-form :mysql [_] (h2x/with-database-type-info [:now [:inline 6]] "timestamp")) |
(defmethod driver/humanize-connection-error-message :mysql
[_ message]
(condp re-matches message
#"^Communications link failure\s+The last packet sent successfully to the server was 0 milliseconds ago. The driver has not received any packets from the server.$"
:cannot-connect-check-host-and-port
#"^Unknown database .*$"
:database-name-incorrect
#"Access denied for user.*$"
:username-or-password-incorrect
#"Must specify port after ':' in connection string"
:invalid-hostname
;; else
message)) | |
#_{:clj-kondo/ignore [:deprecated-var]}
(defmethod sql-jdbc.sync/db-default-timezone :mysql
[_ spec]
(let [sql (str "SELECT @@GLOBAL.time_zone AS global_tz,"
" @@system_time_zone AS system_tz,"
" time_format("
" timediff("
" now(), convert_tz(now(), @@GLOBAL.time_zone, '+00:00')"
" ),"
" '%H:%i'"
" ) AS 'offset';")
[{:keys [global_tz system_tz offset]}] (jdbc/query spec sql)
the-valid-id (fn [zone-id]
(when zone-id
(try
(.getId (t/zone-id zone-id))
(catch Throwable _))))]
(or
;; if global timezone ID is 'SYSTEM', then try to use the system timezone ID
(when (= global_tz "SYSTEM")
(the-valid-id system_tz))
;; otherwise try to use the global ID
(the-valid-id global_tz)
;; failing that, calculate the offset between now in the global timezone and now in UTC. Non-negative offsets
;; don't come back with `+` so add that if needed
(if (str/starts-with? offset "-")
offset
(str \+ offset))))) | |
(defmethod driver/db-start-of-week :mysql [_] :sunday) | |
+----------------------------------------------------------------------------------------------------------------+ | metabase.driver.sql impls | +----------------------------------------------------------------------------------------------------------------+ | |
(defmethod sql.qp/unix-timestamp->honeysql [:mysql :seconds] [_ _ expr] [:from_unixtime expr]) | |
(defmethod sql.qp/cast-temporal-string [:mysql :Coercion/ISO8601->DateTime] [_driver _coercion-strategy expr] (h2x/->datetime expr)) | |
(defmethod sql.qp/cast-temporal-string [:mysql :Coercion/YYYYMMDDHHMMSSString->Temporal] [_driver _coercion-strategy expr] [:convert expr [:raw "DATETIME"]]) | |
(defmethod sql.qp/cast-temporal-byte [:mysql :Coercion/YYYYMMDDHHMMSSBytes->Temporal] [driver _coercion-strategy expr] (sql.qp/cast-temporal-string driver :Coercion/YYYYMMDDHHMMSSString->Temporal expr)) | |
(defn- date-format [format-str expr] [:date_format expr (h2x/literal format-str)]) | |
From the dox:
See https://dev.mysql.com/doc/refman/8.0/en/date-and-time-functions.html#function_date-format for a list of format specifiers. | (defn- str-to-date
[format-str expr]
(let [contains-date-parts? (some #(str/includes? format-str %)
["%a" "%b" "%c" "%D" "%d" "%e" "%j" "%M" "%m" "%U"
"%u" "%V" "%v" "%W" "%w" "%X" "%x" "%Y" "%y"])
contains-time-parts? (some #(str/includes? format-str %)
["%f" "%H" "%h" "%I" "%i" "%k" "%l" "%p" "%r" "%S" "%s" "%T"])
database-type (cond
(and contains-date-parts? (not contains-time-parts?)) "date"
(and contains-time-parts? (not contains-date-parts?)) "time"
:else "datetime")]
(-> [:str_to_date expr (h2x/literal format-str)]
(h2x/with-database-type-info database-type)))) |
(defmethod sql.qp/->float :mysql [_ value] ;; no-op as MySQL doesn't support cast to float value) | |
(defmethod sql.qp/->integer :mysql [_ value] (h2x/maybe-cast :signed value)) | |
(defmethod sql.qp/->honeysql [:mysql :regex-match-first] [driver [_ arg pattern]] [:regexp_substr (sql.qp/->honeysql driver arg) (sql.qp/->honeysql driver pattern)]) | |
(defmethod sql.qp/->honeysql [:mysql :length] [driver [_ arg]] [:char_length (sql.qp/->honeysql driver arg)]) | |
MySQL supports the ordinary SQL standard database type names for actual type stuff but not for coercions, sometimes. If it doesn't support the ordinary SQL standard type, then we coerce it to a different type that MySQL does support here | (def ^:private database-type->mysql-cast-type-name
{"integer" "signed"
"text" "char"
"double precision" "double"
"bigint" "unsigned"}) |
(defmethod sql.qp/json-query :mysql
[_driver unwrapped-identifier stored-field]
{:pre [(h2x/identifier? unwrapped-identifier)]}
(letfn [(handle-name [x] (str "\"" (if (number? x) (str x) (name x)) "\""))]
(let [field-type (:database-type stored-field)
field-type (get database-type->mysql-cast-type-name field-type field-type)
nfc-path (:nfc-path stored-field)
parent-identifier (sql.qp.u/nfc-field->parent-identifier unwrapped-identifier stored-field)
jsonpath-query (format "$.%s" (str/join "." (map handle-name (rest nfc-path))))
json-extract+jsonpath [:json_extract parent-identifier jsonpath-query]]
(case (u/lower-case-en field-type)
;; If we see JSON datetimes we expect them to be in ISO8601. However, MySQL expects them as something different.
;; We explicitly tell MySQL to go and accept ISO8601, because that is JSON datetimes, although there is no real standard for JSON, ISO8601 is the de facto standard.
"timestamp" [:convert
[:str_to_date json-extract+jsonpath "\"%Y-%m-%dT%T.%fZ\""]
[:raw "DATETIME"]]
"boolean" json-extract+jsonpath
;; in older versions of MySQL you can't do `convert(<string>, double)` or `cast(<string> AS double)` which is
;; equivalent; instead you can do `<string> + 0.0` =(
("float" "double") [:+ json-extract+jsonpath [:inline 0.0]]
[:convert json-extract+jsonpath [:raw (u/upper-case-en field-type)]])))) | |
(defmethod sql.qp/->honeysql [:mysql :field]
[driver [_ id-or-name opts :as mbql-clause]]
(let [stored-field (when (integer? id-or-name)
(lib.metadata/field (qp.store/metadata-provider) id-or-name))
parent-method (get-method sql.qp/->honeysql [:sql :field])
honeysql-expr (parent-method driver mbql-clause)]
(cond
(not (lib.field/json-field? stored-field))
honeysql-expr
(::sql.qp/forced-alias opts)
(keyword (::add/source-alias opts))
:else
(walk/postwalk #(if (h2x/identifier? %)
(sql.qp/json-query :mysql % stored-field)
%)
honeysql-expr)))) | |
Since MySQL doesn't have date_trunc() we fake it by formatting a date to an appropriate string and then converting back to a date. See http://dev.mysql.com/doc/refman/5.6/en/date-and-time-functions.html#function_date-format for an explanation of format specifiers this will generate a SQL statement casting the TIME to a DATETIME so date_format doesn't fail: date_format(CAST(mytime AS DATETIME), '%Y-%m-%d %H') AS mytime | (defn- trunc-with-format [format-str expr] (str-to-date format-str (date-format format-str (h2x/->datetime expr)))) |
(defn- ->date [expr]
(if (h2x/is-of-type? expr "date")
expr
(-> [:date expr]
(h2x/with-database-type-info "date")))) | |
Create and return a date based on a year and a number of days value. | (defn make-date
[year-expr number-of-days]
(-> [:makedate year-expr (sql.qp/inline-num number-of-days)]
(h2x/with-database-type-info "date"))) |
(defmethod sql.qp/date [:mysql :minute]
[_driver _unit expr]
(let [format-str (if (= (h2x/database-type expr) "time")
"%H:%i"
"%Y-%m-%d %H:%i")]
(trunc-with-format format-str expr))) | |
(defmethod sql.qp/date [:mysql :hour]
[_driver _unit expr]
(let [format-str (if (= (h2x/database-type expr) "time")
"%H"
"%Y-%m-%d %H")]
(trunc-with-format format-str expr))) | |
(defmethod sql.qp/date [:mysql :default] [_ _ expr] expr) (defmethod sql.qp/date [:mysql :minute-of-hour] [_ _ expr] (h2x/minute expr)) (defmethod sql.qp/date [:mysql :hour-of-day] [_ _ expr] (h2x/hour expr)) (defmethod sql.qp/date [:mysql :day] [_ _ expr] (->date expr)) (defmethod sql.qp/date [:mysql :day-of-month] [_ _ expr] [:dayofmonth expr]) (defmethod sql.qp/date [:mysql :day-of-year] [_ _ expr] [:dayofyear expr]) (defmethod sql.qp/date [:mysql :month-of-year] [_ _ expr] (h2x/month expr)) (defmethod sql.qp/date [:mysql :quarter-of-year] [_ _ expr] (h2x/quarter expr)) (defmethod sql.qp/date [:mysql :year] [_ _ expr] (make-date (h2x/year expr) 1)) | |
(defmethod sql.qp/date [:mysql :day-of-week] [driver _unit expr] (sql.qp/adjust-day-of-week driver [:dayofweek expr])) | |
To convert a YEARWEEK (e.g. 201530) back to a date you need tell MySQL which day of the week to use, because otherwise as far as MySQL is concerned you could be talking about any of the days in that week | (defmethod sql.qp/date [:mysql :week] [_ _ expr]
(let [extract-week-fn (fn [expr]
(str-to-date "%X%V %W"
(h2x/concat [:yearweek expr]
(h2x/literal " Sunday"))))]
(sql.qp/adjust-start-of-week :mysql extract-week-fn expr))) |
(defmethod sql.qp/date [:mysql :week-of-year-iso] [_ _ expr] (h2x/week expr 3)) | |
(defmethod sql.qp/date [:mysql :month] [_ _ expr]
(str-to-date "%Y-%m-%d"
(h2x/concat (date-format "%Y-%m" expr)
(h2x/literal "-01")))) | |
Truncating to a quarter is trickier since there aren't any format strings. See the explanation in the H2 driver, which does the same thing but with slightly different syntax. | (defmethod sql.qp/date [:mysql :quarter] [_ _ expr]
(str-to-date "%Y-%m-%d"
(h2x/concat (h2x/year expr)
(h2x/literal "-")
(h2x/- (h2x/* (h2x/quarter expr)
3)
2)
(h2x/literal "-01")))) |
(defmethod sql.qp/->honeysql [:mysql :convert-timezone]
[driver [_ arg target-timezone source-timezone]]
(let [expr (sql.qp/->honeysql driver arg)
timestamp? (h2x/is-of-type? expr "timestamp")]
(sql.u/validate-convert-timezone-args timestamp? target-timezone source-timezone)
(h2x/with-database-type-info
[:convert_tz expr (or source-timezone (qp.timezone/results-timezone-id)) target-timezone]
"datetime"))) | |
(defn- timestampdiff-dates [unit x y] [:timestampdiff [:raw (name unit)] (h2x/->date x) (h2x/->date y)]) | |
(defn- timestampdiff [unit x y] [:timestampdiff [:raw (name unit)] x y]) | |
(defmethod sql.qp/datetime-diff [:mysql :year] [_driver _unit x y] (timestampdiff-dates :year x y)) (defmethod sql.qp/datetime-diff [:mysql :quarter] [_driver _unit x y] (timestampdiff-dates :quarter x y)) (defmethod sql.qp/datetime-diff [:mysql :month] [_driver _unit x y] (timestampdiff-dates :month x y)) (defmethod sql.qp/datetime-diff [:mysql :week] [_driver _unit x y] (timestampdiff-dates :week x y)) (defmethod sql.qp/datetime-diff [:mysql :day] [_driver _unit x y] [:datediff y x]) (defmethod sql.qp/datetime-diff [:mysql :hour] [_driver _unit x y] (timestampdiff :hour x y)) (defmethod sql.qp/datetime-diff [:mysql :minute] [_driver _unit x y] (timestampdiff :minute x y)) (defmethod sql.qp/datetime-diff [:mysql :second] [_driver _unit x y] (timestampdiff :second x y)) | |
+----------------------------------------------------------------------------------------------------------------+ | metabase.driver.sql-jdbc impls | +----------------------------------------------------------------------------------------------------------------+ | |
(defmethod sql-jdbc.sync/database-type->base-type :mysql
[_ database-type]
({:BIGINT :type/BigInteger
:BINARY :type/*
:BIT :type/Boolean
:BLOB :type/*
:CHAR :type/Text
:DATE :type/Date
:DATETIME :type/DateTime
:DECIMAL :type/Decimal
:DOUBLE :type/Float
:ENUM :type/*
:FLOAT :type/Float
:INT :type/Integer
:INTEGER :type/Integer
:LONGBLOB :type/*
:LONGTEXT :type/Text
:MEDIUMBLOB :type/*
:MEDIUMINT :type/Integer
:MEDIUMTEXT :type/Text
:NUMERIC :type/Decimal
:REAL :type/Float
:SET :type/*
:SMALLINT :type/Integer
:TEXT :type/Text
:TIME :type/Time
:TIMESTAMP :type/DateTimeWithLocalTZ ; stored as UTC in the database
:TINYBLOB :type/*
:TINYINT :type/Integer
:TINYTEXT :type/Text
:VARBINARY :type/*
:VARCHAR :type/Text
:YEAR :type/Integer
:JSON :type/JSON}
;; strip off " UNSIGNED" from end if present
(keyword (str/replace (name database-type) #"\sUNSIGNED$" "")))) | |
(defmethod sql-jdbc.sync/column->semantic-type :mysql
[_ database-type _]
;; More types to be added when we start caring about them
(case database-type
"JSON" :type/SerializedJSON
nil)) | |
Map of args for the MySQL/MariaDB JDBC connection string. | (def ^:private default-connection-args
{ ;; 0000-00-00 dates are valid in MySQL; convert these to `null` when they come back because they're illegal in Java
:zeroDateTimeBehavior "convertToNull"
;; Force UTF-8 encoding of results
:useUnicode true
:characterEncoding "UTF8"
:characterSetResults "UTF8"
;; GZIP compress packets sent between Metabase server and MySQL/MariaDB database
:useCompression true}) |
(defn- maybe-add-program-name-option [jdbc-spec additional-options-map]
;; connectionAttributes (if multiple) are separated by commas, so values that contain spaces are OK, so long as they
;; don't contain a comma; our mb-version-and-process-identifier shouldn't contain one, but just to be on the safe side
(let [set-prog-nm-fn (fn []
(let [prog-name (str/replace config/mb-version-and-process-identifier "," "_")]
(assoc jdbc-spec :connectionAttributes (str "program_name:" prog-name))))]
(if-let [conn-attrs (get additional-options-map "connectionAttributes")]
(if (str/includes? conn-attrs "program_name")
jdbc-spec ; additional-options already includes the program_name; don't set it here
(set-prog-nm-fn))
(set-prog-nm-fn)))) ; additional-options did not contain connectionAttributes at all; set it | |
(defmethod sql-jdbc.conn/connection-details->spec :mysql
[_ {ssl? :ssl, :keys [additional-options ssl-cert], :as details}]
;; In versions older than 0.32.0 the MySQL driver did not correctly save `ssl?` connection status. Users worked
;; around this by including `useSSL=true`. Check if that's there, and if it is, assume SSL status. See #9629
;;
;; TODO - should this be fixed by a data migration instead?
(let [addl-opts-map (sql-jdbc.common/additional-options->map additional-options :url "=" false)
ssl? (or ssl? (= "true" (get addl-opts-map "useSSL")))
ssl-cert? (and ssl? (some? ssl-cert))]
(when (and ssl? (not (contains? addl-opts-map "trustServerCertificate")))
(log/info (trs "You may need to add 'trustServerCertificate=true' to the additional connection options to connect with SSL.")))
(merge
default-connection-args
;; newer versions of MySQL will complain if you don't specify this when not using SSL
{:useSSL (boolean ssl?)}
(let [details (-> (if ssl-cert? (set/rename-keys details {:ssl-cert :serverSslCert}) details)
(set/rename-keys {:dbname :db})
(dissoc :ssl))]
(-> (mdb.spec/spec :mysql details)
(maybe-add-program-name-option addl-opts-map)
(sql-jdbc.common/handle-additional-options details)))))) | |
(defmethod sql-jdbc.sync/active-tables :mysql [& args] (apply sql-jdbc.sync/post-filtered-active-tables args)) | |
(defmethod sql-jdbc.sync/excluded-schemas :mysql
[_]
#{"INFORMATION_SCHEMA"}) | |
(defmethod sql.qp/quote-style :mysql [_] :mysql) | |
If this fails you need to load the timezone definitions from your system into MySQL; run the command See https://dev.mysql.com/doc/refman/5.7/en/time-zone-support.html for details | (defmethod sql-jdbc.execute/set-timezone-sql :mysql [_] "SET @@session.time_zone = %s;") |
(defmethod sql-jdbc.execute/set-parameter [:mysql OffsetTime] [driver ps i t] ;; convert to a LocalTime so MySQL doesn't get F U S S Y (sql-jdbc.execute/set-parameter driver ps i (t/local-time (t/with-offset-same-instant t (t/zone-offset 0))))) | |
Regardless of session timezone it seems to be the case that OffsetDateTimes get normalized to UTC inside MySQL Since MySQL TIMESTAMPs aren't timezone-aware this means comparisons are done between timestamps in the report timezone and the local datetime portion of the parameter, in UTC. Bad! Convert it to a LocalDateTime, in the report timezone, so comparisions will work correctly. See also — https://dev.mysql.com/doc/refman/5.5/en/datetime.html TIMEZONE FIXME — not 100% sure this behavior makes sense | (defmethod sql-jdbc.execute/set-parameter [:mysql OffsetDateTime]
[driver ^java.sql.PreparedStatement ps ^Integer i t]
(let [zone (t/zone-id (qp.timezone/results-timezone-id))
offset (.. zone getRules (getOffset (t/instant t)))
t (t/local-date-time (t/with-offset-same-instant t offset))]
(sql-jdbc.execute/set-parameter driver ps i t))) |
MySQL TIMESTAMPS are actually TIMESTAMP WITH LOCAL TIME ZONE, i.e. they are stored normalized to UTC when stored. However, MySQL returns them in the report time zone in an effort to make our lives horrible. | (defmethod sql-jdbc.execute/read-column-thunk [:mysql Types/TIMESTAMP]
[_ ^ResultSet rs ^ResultSetMetaData rsmeta ^Integer i]
;; Check and see if the column type is `TIMESTAMP` (as opposed to `DATETIME`, which is the equivalent of
;; LocalDateTime), and normalize it to a UTC timestamp if so.
(if (= (.getColumnTypeName rsmeta i) "TIMESTAMP")
(fn read-timestamp-thunk []
(when-let [t (.getObject rs i LocalDateTime)]
(t/with-offset-same-instant (t/offset-date-time t (t/zone-id (qp.timezone/results-timezone-id))) (t/zone-offset 0))))
(fn read-datetime-thunk []
(.getObject rs i LocalDateTime)))) |
Results of There is currently no way to tell whether the column is the result of a Thus we should attempt to fetch temporal results the normal way and fall back to string representations for cases where the values are unparseable. | (defmethod sql-jdbc.execute/read-column-thunk [:mysql Types/TIME]
[driver ^ResultSet rs rsmeta ^Integer i]
(let [parent-thunk ((get-method sql-jdbc.execute/read-column-thunk [:sql-jdbc Types/TIME]) driver rs rsmeta i)]
(fn read-time-thunk []
(try
(parent-thunk)
(catch Throwable _
(.getString rs i)))))) |
Mysql 8.1+ returns results of YEAR(..) function having a YEAR type. In Mysql 8.0.33, return value of that function has an integral type. Let's make the returned values consistent over mysql versions. Context: https://dev.mysql.com/doc/connector-j/en/connector-j-YEAR.html | (defmethod sql-jdbc.execute/read-column-thunk [:mysql Types/DATE]
[driver ^ResultSet rs ^ResultSetMetaData rsmeta ^Integer i]
(if (= "YEAR" (.getColumnTypeName rsmeta i))
(fn read-time-thunk []
(when-let [x (.getObject rs i)]
(.getYear (.toLocalDate ^java.sql.Date x))))
(let [parent-thunk ((get-method sql-jdbc.execute/read-column-thunk [:sql-jdbc Types/DATE]) driver rs rsmeta i)]
parent-thunk))) |
(defn- format-offset [t]
(let [offset (t/format "ZZZZZ" (t/zone-offset t))]
(if (= offset "Z")
"UTC"
offset))) | |
(defmethod unprepare/unprepare-value [:mysql OffsetTime]
[_ t]
;; MySQL doesn't support timezone offsets in literals so pass in a local time literal wrapped in a call to convert
;; it to the appropriate timezone
(format "convert_tz('%s', '%s', @@session.time_zone)"
(t/format "HH:mm:ss.SSS" t)
(format-offset t))) | |
(defmethod unprepare/unprepare-value [:mysql OffsetDateTime]
[_ t]
(format "convert_tz('%s', '%s', @@session.time_zone)"
(t/format "yyyy-MM-dd HH:mm:ss.SSS" t)
(format-offset t))) | |
(defmethod unprepare/unprepare-value [:mysql ZonedDateTime]
[_ t]
(format "convert_tz('%s', '%s', @@session.time_zone)"
(t/format "yyyy-MM-dd HH:mm:ss.SSS" t)
(str (t/zone-id t)))) | |
(defmethod driver/upload-type->database-type :mysql
[_driver upload-type]
(case upload-type
::upload/varchar-255 [[:varchar 255]]
::upload/text [:text]
::upload/int [:bigint]
::upload/auto-incrementing-int-pk [:bigint :not-null :auto-increment :primary-key]
::upload/float [:double]
::upload/boolean [:boolean]
::upload/date [:date]
::upload/datetime [:datetime]
::upload/offset-datetime [:timestamp])) | |
(defmethod driver/table-name-length-limit :mysql [_driver] ;; https://dev.mysql.com/doc/refman/8.0/en/identifier-length.html 64) | |
(defn- format-load [_clause [file-path table-name]] [(format "LOAD DATA LOCAL INFILE '%s' INTO TABLE %s" file-path (sql/format-entity table-name))]) | |
(sql/register-clause! ::load format-load :insert-into) | |
Remove the offset from a datetime, returning a string representation in whatever timezone the | (defn- offset-datetime->unoffset-datetime
[driver database ^OffsetDateTime offset-time]
(let [zone-id (t/zone-id (driver/db-default-timezone driver database))]
(t/local-date-time offset-time zone-id))) |
Convert a value into a string that's safe for insertion | (defmulti ^:private value->string
{:arglists '([driver val])}
(fn [_ val] (type val))) |
(defmethod value->string :default [_driver val] (str val)) | |
(defmethod value->string nil [_driver _val] nil) | |
(defmethod value->string Boolean
[_driver val]
(if val
"1"
"0")) | |
(defmethod value->string LocalDateTime [_driver val] (t/format :iso-local-date-time val)) | |
(let [zulu-fmt "yyyy-MM-dd'T'HH:mm:ss"
offset-fmt "XXX"
zulu-formatter (DateTimeFormatter/ofPattern zulu-fmt)
offset-formatter (DateTimeFormatter/ofPattern (str zulu-fmt offset-fmt))]
(defmethod value->string OffsetDateTime
[driver ^OffsetDateTime val]
(let [uploads-db (upload/current-database)]
(if (mariadb? uploads-db)
(offset-datetime->unoffset-datetime driver uploads-db val)
(t/format (if (.equals (.getOffset val) ZoneOffset/UTC)
zulu-formatter
offset-formatter)
val))))) | |
(defn- sanitize-value
;; Per https://dev.mysql.com/doc/refman/8.0/en/load-data.html#load-data-field-line-handling
;; Backslash is the MySQL escape character within strings in SQL statements. Thus, to specify a literal backslash,
;; you must specify two backslashes for the value to be interpreted as a single backslash. The escape sequences
;; '\t' and '\n' specify tab and newline characters, respectively.
[v]
(if (nil? v)
"\\N"
(str/replace v #"\\|\n|\r|\t" {"\\" "\\\\"
"\n" "\\n"
"\r" "\\r"
"\t" "\\t"}))) | |
(defn- row->tsv
[driver column-count row]
(when (not= column-count (count row))
(throw (Exception. (format "ERROR: missing data in row \"%s\ (str/join "," row)))))
(->> row
(map (comp sanitize-value (partial value->string driver)))
(str/join "\t"))) | |
The value of the given global variable in the DB. Does not do any type coercion, so, e.g., booleans come back as "ON" and "OFF". | (defn- get-global-variable
[db-id var-name]
(:value
(first
(jdbc/query (sql-jdbc.conn/db->pooled-connection-spec db-id)
["show global variables like ?" var-name])))) |
(defmethod driver/insert-into! :mysql
[driver db-id ^String table-name column-names values]
;; `local_infile` must be turned on per
;; https://dev.mysql.com/doc/refman/8.0/en/load-data.html#load-data-local
(if (not= (get-global-variable db-id "local_infile") "ON")
;; If it isn't turned on, fall back to the generic "INSERT INTO ..." way
((get-method driver/insert-into! :sql-jdbc) driver db-id table-name column-names values)
(let [temp-file (File/createTempFile table-name ".tsv")
file-path (.getAbsolutePath temp-file)]
(try
(let [tsvs (map (partial row->tsv driver (count column-names)) values)
sql (sql/format {::load [file-path (keyword table-name)]
:columns (map keyword column-names)}
:quoted true
:dialect (sql.qp/quote-style driver))]
(with-open [^java.io.Writer writer (jio/writer file-path)]
(doseq [value (interpose \newline tsvs)]
(.write writer (str value))))
(sql-jdbc.execute/do-with-connection-with-options
driver
db-id
nil
(fn [conn]
(jdbc/execute! {:connection conn} sql))))
(finally
(.delete temp-file)))))) | |
Parses the contents of a row from the output of a There are two types of grants we care about: privileges and roles. Privilege example:
(parse-grant "GRANT SELECT, INSERT, UPDATE, DELETE ON Role example: (parse-grant "GRANT 'examplerole1'@'%','examplerole2'@'%' TO 'metabase'@'localhost'") => {:type :roles :roles #{'examplerole1'@'%' 'examplerole2'@'%'}} | (defn- parse-grant
[grant]
(condp re-find grant
#"^GRANT PROXY ON "
nil
#"^GRANT (.+) ON FUNCTION "
nil
#"^GRANT (.+) ON PROCEDURE "
nil
;; GRANT
;; priv_type [(column_list)]
;; [, priv_type [(column_list)]] ...
;; ON object
;; TO user etc.
;; }
;; For now we ignore column-level privileges. But this is how we could get them in the future.
#"^GRANT (.+) ON (.+) TO "
:>>
(fn [[_ priv-types object]]
(when-let [priv-types' (if (= priv-types "ALL PRIVILEGES")
#{:select :update :delete :insert}
(let [split-priv-types (->> (str/split priv-types #", ")
(map (comp keyword u/lower-case-en))
set)]
(set/intersection #{:select :update :delete :insert} split-priv-types)))]
{:type :privileges
:privilege-types (not-empty priv-types')
:level (cond
(= object "*.*") :global
(str/ends-with? object ".*") :database
:else :table)
:object object}))
;; GRANT role [, role] ... TO user etc.
#"^GRANT (.+) TO "
:>>
(fn [[_ roles]]
{:type :roles
:roles (set (map u/lower-case-en (str/split roles #",")))}))) |
Returns a list of parsed privilege grants for a user, taking into account the roles that the user has.
It does so by first querying: | (defn- privilege-grants-for-user
[conn-spec user]
(let [query (fn [q] (->> (jdbc/query conn-spec q {:as-arrays? true})
(drop 1)
(map first)))
grants (map parse-grant (query (str "SHOW GRANTS FOR " user)))
{role-grants :roles
privilege-grants :privileges} (group-by :type grants)]
(if (seq role-grants)
(let [roles (:roles (first role-grants))
grants (map parse-grant (query (str "SHOW GRANTS FOR " user "USING " (str/join "," roles))))
{privilege-grants :privileges} (group-by :type grants)]
privilege-grants)
privilege-grants))) |
Given a set of parsed grants for a user, a database name, and a list of table names in the database, return a map with table names as keys, and the set of privilege types that the user has on the table as values. The rules are: - global grants apply to all tables - database grants apply to all tables in the database - table grants apply to the table | (defn- table-names->privileges
[privilege-grants database-name table-names]
(let [{global-grants :global
database-grants :database
table-grants :table} (group-by :level privilege-grants)
lower-database-name (u/lower-case-en database-name)
all-table-privileges (set/union (:privilege-types (first global-grants))
(:privilege-types (m/find-first #(= (:object %) (str "`" lower-database-name "`.*"))
database-grants)))
table-privileges (into {}
(keep (fn [grant]
(when-let [match (re-find (re-pattern (str "^`" lower-database-name "`.`(.+)`")) (:object grant))]
(let [[_ table-name] match]
[table-name (:privilege-types grant)]))))
table-grants)]
(into {}
(keep (fn [table-name]
(when-let [privileges (not-empty (set/union all-table-privileges (get table-privileges table-name)))]
[table-name privileges])))
table-names))) |
(defmethod driver/current-user-table-privileges :mysql
[_driver database]
;; MariaDB doesn't allow users to query the privileges of roles a user might have (unless they have select privileges
;; for the mysql database), so we can't query the full privileges of the current user.
(when-not (mariadb? database)
(let [conn-spec (sql-jdbc.conn/db->pooled-connection-spec database)
db-name (or (get-in database [:details :db])
;; some tests are stil using dbname
(get-in database [:details :dbname]))
table-names (->> (jdbc/query conn-spec "SHOW TABLES" {:as-arrays? true})
(drop 1)
(map first))]
(for [[table-name privileges] (table-names->privileges (privilege-grants-for-user conn-spec "CURRENT_USER()")
db-name
table-names)]
{:role nil
:schema nil
:table table-name
:select (contains? privileges :select)
:update (contains? privileges :update)
:insert (contains? privileges :insert)
:delete (contains? privileges :delete)})))) | |
Method impls for [[metabase.driver.sql-jdbc.actions]] for `:mysql. | (ns metabase.driver.mysql.actions (:require [clojure.java.jdbc :as jdbc] [clojure.string :as str] [metabase.actions.error :as actions.error] [metabase.driver.sql-jdbc.actions :as sql-jdbc.actions] [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn] [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute] [metabase.driver.sql.query-processor :as sql.qp] [metabase.util :as u] [metabase.util.i18n :refer [deferred-trun tru]] [metabase.util.log :as log])) |
(set! *warn-on-reflection* true) | |
TODO -- we should probably be TTL caching this information. Otherwise parsing 100 errors for a bulk action will result in 100 identical data warehouse queries. It's not like constraint columns are something we would expect to change regularly anyway. (See the twin function in namespace metabase.driver.postgres.actions.) In the error message we have no information about catalog and schema, so we do the query with the information we have and check if the result is unique. If it's not, we log a warning and signal that we couldn't find the columns names. | |
(defn- remove-backticks [id]
(when id
(-> id
(str/replace "``" "`")
(str/replace #"^`?(.+?)`?$" "$1")))) | |
Given a constraint with | (defn- constraint->column-names
[database constraint-name]
(let [jdbc-spec (sql-jdbc.conn/db->pooled-connection-spec (u/the-id database))
sql-args ["select table_catalog, table_schema, column_name from information_schema.key_column_usage where constraint_name = ?" constraint-name]]
(first
(reduce
(fn [[columns catalog schema] {:keys [table_catalog table_schema column_name]}]
(if (and (or (nil? catalog) (= table_catalog catalog))
(or (nil? schema) (= table_schema schema)))
[(conj columns column_name) table_catalog table_schema]
(do (log/warnf "Ambiguous catalog/schema for constraint %s in table %s"
constraint-name)
(reduced nil))))
[[] nil nil]
(jdbc/reducible-query jdbc-spec sql-args {:identifers identity, :transaction? false}))))) |
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:mysql actions.error/violate-not-null-constraint]
[_driver error-type _database _action-type error-message]
(or
(when-let [[_ column]
(re-find #"Column '(.+)' cannot be null" error-message)]
{:type error-type
:message (tru "{0} must have values." (str/capitalize column))
:errors {column (tru "You must provide a value.")}})
(when-let [[_ column]
(re-find #"Field '(.+)' doesn't have a default value" error-message)]
{:type error-type
:message (tru "{0} must have values." (str/capitalize column))
:errors {column (tru "You must provide a value.")}}))) | |
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:mysql actions.error/violate-unique-constraint]
[_driver error-type database _action-type error-message]
(when-let [[_match constraint]
(re-find #"Duplicate entry '.+' for key '(.+)'" error-message)]
(let [constraint (last (str/split constraint #"\."))
columns (constraint->column-names database constraint)]
{:type error-type
:message (tru "{0} already {1}." (u/build-sentence (map str/capitalize columns) :stop? false) (deferred-trun "exists" "exist" (count columns)))
:errors (reduce (fn [acc col]
(assoc acc col (tru "This {0} value already exists." (str/capitalize col))))
{}
columns)}))) | |
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:mysql actions.error/violate-foreign-key-constraint]
[_driver error-type _database action-type error-message]
(or
(when-let [[_match _ref-table _constraint _fkey-cols column _key-cols]
(re-find #"Cannot delete or update a parent row: a foreign key constraint fails \((.+), CONSTRAINT (.+) FOREIGN KEY \((.+)\) REFERENCES (.+) \((.+)\)\)" error-message)]
(merge {:type error-type}
(case action-type
:row/delete
{:message (tru "Other tables rely on this row so it cannot be deleted.")
:errors {}}
:row/update
(let [column (remove-backticks column)]
{:message (tru "Unable to update the record.")
:errors {column (tru "This {0} does not exist." (str/capitalize column))}}))))
(when-let [[_match _ref-table _constraint column _fk-table _fk-col]
(re-find #"Cannot add or update a child row: a foreign key constraint fails \((.+), CONSTRAINT (.+) FOREIGN KEY \((.+)\) REFERENCES (.+) \((.+)\)\)" error-message)]
(let [column (remove-backticks column)]
{:type error-type
:message (case action-type
:row/create
(tru "Unable to create a new record.")
:row/update
(tru "Unable to update the record."))
:errors {(remove-backticks column) (tru "This {0} does not exist." (str/capitalize (remove-backticks column)))}})))) | |
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:mysql actions.error/incorrect-value-type]
[_driver error-type _database _action-type error-message]
(when-let [[_ expected-type _value _database _table column _row]
(re-find #"Incorrect (.+?) value: '(.+)' for column (?:(.+)\.)??(?:(.+)\.)?(.+) at row (\d+)" error-message)]
(let [column (-> column (str/replace #"^'(.*)'$" "$1") remove-backticks)]
{:type error-type
:message (tru "Some of your values aren’t of the correct type for the database.")
:errors {column (tru "This value should be of type {0}." (str/capitalize expected-type))}}))) | |
There is a huge discrepancy between the types used in DDL statements and types that can be used in CAST: cf https://dev.mysql.com/doc/refman/8.0/en/data-types.html et https://dev.mysql.com/doc/refman/5.7/en/data-types.html vs https://dev.mysql.com/doc/refman/5.7/en/cast-functions.html#function_cast et https://dev.mysql.com/doc/refman/8.0/en/cast-functions.html#function_cast | (defmethod sql-jdbc.actions/base-type->sql-type-map :mysql
[_driver]
{:type/Date "DATE"
;; (3) is fractional seconds precision, i.e. millisecond precision
:type/DateTime "DATETIME(3)"
:type/DateTimeWithTZ "DATETIME(3)"
:type/JSON "JSON"
:type/Time "TIME(3)"}) |
MySQL doesn't need to do anything special with nested transactions; the original transaction can proceed even if some specific statement errored. | (defmethod sql-jdbc.actions/do-nested-transaction :mysql [_driver _conn thunk] (thunk)) |
(defn- primary-keys [driver jdbc-spec table-components]
(let [schema (when (next table-components) (first table-components))
table (last table-components)]
(sql-jdbc.execute/do-with-connection-with-options
driver
jdbc-spec
nil
(fn [^java.sql.Connection conn]
(let [metadata (.getMetaData conn)]
(with-open [rset (.getPrimaryKeys metadata nil schema table)]
(loop [acc []]
(if-not (.next rset)
acc
(recur (conj acc (.getString rset "COLUMN_NAME"))))))))))) | |
MySQL returns the generated ID (of which cannot be more than one) as insert_id. If this is not null, we determine the name of the primary key and query the corresponding record. If the table has no auto_increment primary key, then we make a query with the values inserted in order to get the default values. If the table has no primary key and this query returns multiple rows, then we cannot know which one resulted from this insert, so we log a warning and return nil. | (defmethod sql-jdbc.actions/select-created-row :mysql
[driver create-hsql conn {:keys [insert_id] :as results}]
(let [jdbc-spec {:connection conn}
table-components (-> create-hsql :insert-into :components)
pks (primary-keys driver jdbc-spec table-components)
where-clause (if insert_id
[:= (-> pks first keyword) insert_id]
(into [:and]
(for [[col val] (:insert-into create-hsql)]
[:= (keyword col) val])))
select-hsql (-> create-hsql
(dissoc :insert-into :values)
(assoc :select [:*]
:from [(:insert-into create-hsql)]
:where where-clause))
select-sql-args (sql.qp/format-honeysql driver select-hsql)
query-results (jdbc/query jdbc-spec
select-sql-args
{:identifiers identity, :transaction? false})]
(if (next query-results)
(log/warn "cannot identify row inserted by" create-hsql "using results" results)
(first query-results)))) |
(ns metabase.driver.mysql.ddl (:require [clojure.core.async :as a] [clojure.string :as str] [honey.sql :as sql] [java-time.api :as t] [metabase.driver.ddl.interface :as ddl.i] [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn] [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute] [metabase.driver.sql.ddl :as sql.ddl] [metabase.public-settings :as public-settings] [metabase.query-processor :as qp] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log]) (:import (java.sql SQLNonTransientConnectionException))) | |
(set! *warn-on-reflection* true) | |
(defn- exec-async [driver conn-chan db-spec sql+params]
(a/thread
(sql-jdbc.execute/do-with-connection-with-options
driver
db-spec
{:write? true}
(fn [^java.sql.Connection conn]
(try
(let [pid (:pid (first (sql.ddl/jdbc-query conn ["select connection_id() pid"])))]
(a/put! conn-chan pid)
(sql.ddl/jdbc-query conn sql+params))
(catch SQLNonTransientConnectionException _e
;; Our connection may be killed due to timeout, [[kill!]] will throw an appropriate exception
nil)
(catch Exception e
(log/warn e)
e)))))) | |
(defn- kill! [conn pid]
(let [results (sql.ddl/jdbc-query conn ["show processlist"])
result? (some (fn [r]
(and (= (:id r) pid)
(str/starts-with? (or (:info r) ) "-- Metabase")))
results)]
(when result?
;; Can't use a prepared parameter with these statements
(sql.ddl/execute! conn [(str "kill " pid)])
(throw (Exception. (trs "Killed mysql process id {0} due to timeout." pid)))))) | |
Spins up another channel to execute the statement.
If | (defn- execute-with-timeout!
[driver conn db-spec timeout-ms sql+params]
(let [conn-chan (a/promise-chan)
exec-chan (exec-async driver conn-chan db-spec sql+params)
pid (a/<!! conn-chan)
_ (a/close! conn-chan)
timeout-chan (a/timeout timeout-ms)
[v port] (a/alts!! [timeout-chan exec-chan])]
(a/close! exec-chan)
(cond
(= port timeout-chan) (kill! conn pid)
(= port exec-chan) (if (instance? Exception v)
(throw v)
v)))) |
(defmethod ddl.i/refresh! :mysql
[driver database definition dataset-query]
(let [{:keys [query params]} (qp/compile dataset-query)
db-spec (sql-jdbc.conn/db->pooled-connection-spec database)]
(sql-jdbc.execute/do-with-connection-with-options
driver
database
{:write? true}
(fn [conn]
(sql.ddl/execute! conn [(sql.ddl/drop-table-sql database (:table-name definition))])
;; It is possible that this fails and rollback would not restore the table.
;; That is ok, the persisted-info will be marked inactive and the next refresh will try again.
(execute-with-timeout! driver
conn
db-spec
(.toMillis (t/minutes 10))
(into [(sql.ddl/create-table-sql database definition query)] params))
{:state :success})))) | |
(defmethod ddl.i/unpersist! :mysql
[driver database persisted-info]
(sql-jdbc.execute/do-with-connection-with-options
driver
database
{:write? true}
(fn [^java.sql.Connection conn]
(try
(sql.ddl/execute! conn [(sql.ddl/drop-table-sql database (:table_name persisted-info))])
(catch Exception e
(log/warn e)
(throw e)))))) | |
(defmethod ddl.i/check-can-persist :mysql
[{driver :engine, :as database}]
(let [schema-name (ddl.i/schema-name database (public-settings/site-uuid))
table-name (format "persistence_check_%s" (rand-int 10000))
db-spec (sql-jdbc.conn/db->pooled-connection-spec database)
steps [[:persist.check/create-schema
(fn check-schema [conn]
(let [existing-schemas (->> ["select schema_name from information_schema.schemata"]
(sql.ddl/jdbc-query conn)
(map :schema_name)
(into #{}))]
(or (contains? existing-schemas schema-name)
(sql.ddl/execute! conn [(sql.ddl/create-schema-sql database)]))))
(fn undo-check-schema [conn]
(sql.ddl/execute! conn [(sql.ddl/drop-schema-sql database)]))]
[:persist.check/create-table
(fn create-table [conn]
(execute-with-timeout! driver
conn
db-spec
(.toMillis (t/minutes 10))
[(sql.ddl/create-table-sql
database
{:table-name table-name
:field-definitions [{:field-name "field"
:base-type :type/Text}]}
"select 1")]))
(fn undo-create-table [conn]
(sql.ddl/execute! conn [(sql.ddl/drop-table-sql database table-name)]))]
[:persist.check/read-table
(fn read-table [conn]
(sql.ddl/jdbc-query conn [(format "select * from %s.%s"
schema-name table-name)]))
(constantly nil)]
[:persist.check/delete-table
(fn delete-table [conn]
(sql.ddl/execute! conn [(sql.ddl/drop-table-sql database table-name)]))
;; This will never be called, if the last step fails it does not need to be undone
(constantly nil)]
[:persist.check/create-kv-table
(fn create-kv-table [conn]
(sql.ddl/execute! conn [(format "drop table if exists %s.cache_info"
schema-name)])
(sql.ddl/execute! conn (sql/format
(ddl.i/create-kv-table-honey-sql-form schema-name)
{:dialect :mysql})))]
[:persist.check/populate-kv-table
(fn create-kv-table [conn]
(sql.ddl/execute! conn (sql/format
(ddl.i/populate-kv-table-honey-sql-form
schema-name)
{:dialect :mysql})))]]]
;; Unlike postgres, mysql ddl clauses will not rollback in a transaction.
;; So we keep track of undo-steps to manually rollback previous, completed steps.
(sql-jdbc.execute/do-with-connection-with-options
driver
db-spec
{:write? true}
(fn [conn]
(loop [[[step stepfn undofn] & remaining] steps
undo-steps []]
(let [result (try (stepfn conn)
(log/info (trs "Step {0} was successful for db {1}"
step (:name database)))
::valid
(catch Exception e
(log/warn (trs "Error in `{0}` while checking for model persistence permissions." step))
(log/warn e)
(try
(doseq [[undo-step undofn] (reverse undo-steps)]
(log/warn (trs "Undoing step `{0}` for db {1}" undo-step (:name database)))
(undofn conn))
(catch Exception _e
(log/warn (trs "Unable to rollback database check for model persistence"))))
step))]
(cond (and (= result ::valid) remaining)
(recur remaining (conj undo-steps [step undofn]))
(= result ::valid)
[true :persist.check/valid]
:else
[false step]))))))) | |
Database driver for PostgreSQL databases. Builds on top of the SQL JDBC driver, which implements most functionality for JDBC-based drivers. | (ns metabase.driver.postgres
(:require
[clojure.java.jdbc :as jdbc]
[clojure.set :as set]
[clojure.string :as str]
[clojure.walk :as walk]
[honey.sql :as sql]
[java-time.api :as t]
[metabase.db.spec :as mdb.spec]
[metabase.driver :as driver]
[metabase.driver.common :as driver.common]
[metabase.driver.postgres.actions :as postgres.actions]
[metabase.driver.postgres.ddl :as postgres.ddl]
[metabase.driver.sql :as driver.sql]
[metabase.driver.sql-jdbc.common :as sql-jdbc.common]
[metabase.driver.sql-jdbc.connection :as sql-jdbc.conn]
[metabase.driver.sql-jdbc.execute :as sql-jdbc.execute]
[metabase.driver.sql-jdbc.sync :as sql-jdbc.sync]
[metabase.driver.sql.query-processor :as sql.qp]
[metabase.driver.sql.query-processor.util :as sql.qp.u]
[metabase.driver.sql.util :as sql.u]
[metabase.driver.sql.util.unprepare :as unprepare]
[metabase.lib.field :as lib.field]
[metabase.lib.metadata :as lib.metadata]
[metabase.lib.schema.common :as lib.schema.common]
[metabase.lib.schema.temporal-bucketing
:as lib.schema.temporal-bucketing]
[metabase.models.secret :as secret]
[metabase.query-processor.store :as qp.store]
[metabase.query-processor.util.add-alias-info :as add]
[metabase.upload :as upload]
[metabase.util :as u]
[metabase.util.date-2 :as u.date]
[metabase.util.honey-sql-2 :as h2x]
[metabase.util.i18n :refer [trs]]
[metabase.util.log :as log]
[metabase.util.malli :as mu])
(:import
(java.io StringReader)
(java.sql Connection ResultSet ResultSetMetaData Time Types)
(java.time LocalDateTime OffsetDateTime OffsetTime)
(java.util Date UUID)
(org.postgresql.copy CopyManager)
(org.postgresql.jdbc PgConnection))) |
(set! *warn-on-reflection* true) | |
(comment ;; method impls live in these namespaces. postgres.actions/keep-me postgres.ddl/keep-me) | |
(driver/register! :postgres, :parent :sql-jdbc) | |
(defmethod driver/display-name :postgres [_] "PostgreSQL") | |
Features that are supported by Postgres and all of its child drivers like Redshift | (doseq [[feature supported?] {:convert-timezone true
:datetime-diff true
:now true
:persist-models true
:table-privileges true
:schemas true
:connection-impersonation true
:uploads true}]
(defmethod driver/database-supports? [:postgres feature] [_driver _feature _db] supported?)) |
(defmethod driver/database-supports? [:postgres :nested-field-columns] [_driver _feat db] (driver.common/json-unfolding-default db)) | |
Features that are supported by postgres only | (doseq [feature [:actions
:actions/custom
:uploads
:index-info]]
(defmethod driver/database-supports? [:postgres feature]
[driver _feat _db]
(= driver :postgres))) |
+----------------------------------------------------------------------------------------------------------------+ | metabase.driver impls | +----------------------------------------------------------------------------------------------------------------+ | |
(defmethod driver/display-name :postgres [_] "PostgreSQL") | |
(defmethod driver/humanize-connection-error-message :postgres
[_ message]
(condp re-matches message
#"^FATAL: database \".*\" does not exist$"
:database-name-incorrect
#"^No suitable driver found for.*$"
:invalid-hostname
#"^Connection refused. Check that the hostname and port are correct and that the postmaster is accepting TCP/IP connections.$"
:cannot-connect-check-host-and-port
#"^FATAL: role \".*\" does not exist$"
:username-incorrect
#"^FATAL: password authentication failed for user.*$"
:password-incorrect
#"^FATAL: .*$" ; all other FATAL messages: strip off the 'FATAL' part, capitalize, and add a period
(let [[_ message] (re-matches #"^FATAL: (.*$)" message)]
(str (str/capitalize message) \.))
message)) | |
(defmethod driver/db-default-timezone :postgres
[driver database]
(sql-jdbc.execute/do-with-connection-with-options
driver database nil
(fn [^java.sql.Connection conn]
(with-open [stmt (.prepareStatement conn "show timezone;")
rset (.executeQuery stmt)]
(when (.next rset)
(.getString rset 1)))))) | |
(defmethod driver/connection-properties :postgres
[_]
(->>
[driver.common/default-host-details
(assoc driver.common/default-port-details :placeholder 5432)
driver.common/default-dbname-details
driver.common/default-user-details
driver.common/default-password-details
driver.common/cloud-ip-address-info
{:name "schema-filters"
:type :schema-filters
:display-name "Schemas"}
driver.common/default-ssl-details
{:name "ssl-mode"
:display-name (trs "SSL Mode")
:type :select
:options [{:name "allow"
:value "allow"}
{:name "prefer"
:value "prefer"}
{:name "require"
:value "require"}
{:name "verify-ca"
:value "verify-ca"}
{:name "verify-full"
:value "verify-full"}]
:default "require"
:visible-if {"ssl" true}}
{:name "ssl-root-cert"
:display-name (trs "SSL Root Certificate (PEM)")
:type :secret
:secret-kind :pem-cert
;; only need to specify the root CA if we are doing one of the verify modes
:visible-if {"ssl-mode" ["verify-ca" "verify-full"]}}
{:name "ssl-use-client-auth"
:display-name (trs "Authenticate client certificate?")
:type :boolean
;; TODO: does this somehow depend on any of the ssl-mode vals? it seems not (and is in fact orthogonal)
:visible-if {"ssl" true}}
{:name "ssl-client-cert"
:display-name (trs "SSL Client Certificate (PEM)")
:type :secret
:secret-kind :pem-cert
:visible-if {"ssl-use-client-auth" true}}
{:name "ssl-key"
:display-name (trs "SSL Client Key (PKCS-8/DER)")
:type :secret
;; since this can be either PKCS-8 or PKCS-12, we can't model it as a :keystore
:secret-kind :binary-blob
:visible-if {"ssl-use-client-auth" true}}
{:name "ssl-key-password"
:display-name (trs "SSL Client Key Password")
:type :secret
:secret-kind :password
:visible-if {"ssl-use-client-auth" true}}
driver.common/ssh-tunnel-preferences
driver.common/advanced-options-start
driver.common/json-unfolding
(assoc driver.common/additional-options
:placeholder "prepareThreshold=0")
driver.common/default-advanced-options]
(map u/one-or-many)
(apply concat))) | |
(defmethod driver/db-start-of-week :postgres [_] :monday) | |
(defn- get-typenames [{:keys [nspname typname]}]
(cond-> [typname]
(not= nspname "public") (conj (format "\"%s\".\"%s\ nspname typname)))) | |
(defn- enum-types [_driver database]
(into #{}
(comp (mapcat get-typenames)
(map keyword))
(jdbc/query (sql-jdbc.conn/db->pooled-connection-spec database)
[(str "SELECT nspname, typname "
"FROM pg_type t JOIN pg_namespace n ON n.oid = t.typnamespace "
"WHERE t.oid IN (SELECT DISTINCT enumtypid FROM pg_enum e)")]))) | |
(def ^:private ^:dynamic *enum-types* nil) | |
Describe the Fields present in a | (defmethod driver/describe-table :postgres
[driver database table]
(binding [*enum-types* (enum-types driver database)]
(sql-jdbc.sync/describe-table driver database table))) |
+----------------------------------------------------------------------------------------------------------------+ | metabase.driver.sql impls | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- ->timestamp [honeysql-form]
(h2x/cast-unless-type-in "timestamp" #{"timestamp" "timestamptz" "date"} honeysql-form)) | |
Generate a Postgres 'INTERVAL' literal. (sql/format-expr [::interval 2 :day]) => ["INTERVAL '2 day'"] | (defn- format-interval
;; I tried to write this with Malli but couldn't figure out how to make it work. See
;; https://metaboat.slack.com/archives/CKZEMT1MJ/p1676076592468909
[_fn [amount unit]]
{:pre [(number? amount)
(#{:millisecond :second :minute :hour :day :week :month :year} unit)]}
[(format "INTERVAL '%s %s'" (num amount) (name unit))]) |
(sql/register-fn! ::interval #'format-interval) | |
(defn- interval [amount unit] (h2x/with-database-type-info [::interval amount unit] "interval")) | |
(defmethod sql.qp/add-interval-honeysql-form :postgres
[driver hsql-form amount unit]
;; Postgres doesn't support quarter in intervals (#20683)
(if (= unit :quarter)
(recur driver hsql-form (* 3 amount) :month)
(let [hsql-form (->timestamp hsql-form)]
(-> (h2x/+ hsql-form (interval amount unit))
(h2x/with-type-info (h2x/type-info hsql-form)))))) | |
(defmethod sql.qp/current-datetime-honeysql-form :postgres [_driver] (h2x/with-database-type-info :%now "timestamptz")) | |
(defmethod sql.qp/unix-timestamp->honeysql [:postgres :seconds] [_ _ expr] [:to_timestamp expr]) | |
(defmethod sql.qp/cast-temporal-string [:postgres :Coercion/YYYYMMDDHHMMSSString->Temporal] [_driver _coercion-strategy expr] [:to_timestamp expr (h2x/literal "YYYYMMDDHH24MISS")]) | |
(defmethod sql.qp/cast-temporal-byte [:postgres :Coercion/YYYYMMDDHHMMSSBytes->Temporal]
[driver _coercion-strategy expr]
(sql.qp/cast-temporal-string driver :Coercion/YYYYMMDDHHMMSSString->Temporal
[:convert_from expr (h2x/literal "UTF8")])) | |
(defn- extract [unit expr] [::h2x/extract unit expr]) | |
(defn- make-time [hour minute second] (h2x/with-database-type-info [:make_time hour minute second] "time")) | |
(defn- time-trunc [unit expr]
(let [hour [::pg-conversion (extract :hour expr) :integer]
minute (if (#{:minute :second} unit)
[::pg-conversion (extract :minute expr) :integer]
[:inline 0])
second (if (= unit :second)
[::pg-conversion (extract :second expr) ::double]
[:inline 0.0])]
(make-time hour minute second))) | |
(mu/defn ^:private date-trunc
[unit :- ::lib.schema.temporal-bucketing/unit.date-time.truncate
expr]
(condp = (h2x/database-type expr)
;; apparently there is no convenient way to truncate a TIME column in Postgres, you can try to use `date_trunc`
;; but it returns an interval (??) and other insane things. This seems to be slightly less insane.
"time"
(time-trunc unit expr)
"timetz"
(h2x/cast "timetz" (time-trunc unit expr))
#_else
(let [expr' (->timestamp expr)]
(-> [:date_trunc (h2x/literal unit) expr']
(h2x/with-database-type-info (h2x/database-type expr')))))) | |
(defn- extract-from-timestamp [unit expr] (extract unit (->timestamp expr))) | |
(defn- extract-integer [unit expr] (h2x/->integer (extract-from-timestamp unit expr))) | |
(defmethod sql.qp/date [:postgres :default] [_ _ expr] expr) (defmethod sql.qp/date [:postgres :second-of-minute] [_ _ expr] (extract-integer :second expr)) (defmethod sql.qp/date [:postgres :minute] [_ _ expr] (date-trunc :minute expr)) (defmethod sql.qp/date [:postgres :minute-of-hour] [_ _ expr] (extract-integer :minute expr)) (defmethod sql.qp/date [:postgres :hour] [_ _ expr] (date-trunc :hour expr)) (defmethod sql.qp/date [:postgres :hour-of-day] [_ _ expr] (extract-integer :hour expr)) (defmethod sql.qp/date [:postgres :day] [_ _ expr] (h2x/->date expr)) (defmethod sql.qp/date [:postgres :day-of-month] [_ _ expr] (extract-integer :day expr)) (defmethod sql.qp/date [:postgres :day-of-year] [_ _ expr] (extract-integer :doy expr)) (defmethod sql.qp/date [:postgres :month] [_ _ expr] (date-trunc :month expr)) (defmethod sql.qp/date [:postgres :month-of-year] [_ _ expr] (extract-integer :month expr)) (defmethod sql.qp/date [:postgres :quarter] [_ _ expr] (date-trunc :quarter expr)) (defmethod sql.qp/date [:postgres :quarter-of-year] [_ _ expr] (extract-integer :quarter expr)) (defmethod sql.qp/date [:postgres :year] [_ _ expr] (date-trunc :year expr)) (defmethod sql.qp/date [:postgres :year-of-era] [_ _ expr] (extract-integer :year expr)) | |
(defmethod sql.qp/date [:postgres :week-of-year-iso] [_driver _ expr] (extract-integer :week expr)) | |
(defmethod sql.qp/date [:postgres :day-of-week]
[driver _unit expr]
;; Postgres extract(dow ...) returns Sunday(0)...Saturday(6)
;;
;; Since that's different than what we normally consider the [[metabase.driver/db-start-of-week]] for Postgres
;; (Monday) we need to pass in a custom offset here
(sql.qp/adjust-day-of-week driver
(h2x/+ (extract-integer :dow expr) 1)
(driver.common/start-of-week-offset-for-day :sunday))) | |
(defmethod sql.qp/date [:postgres :week] [_ _ expr] (sql.qp/adjust-start-of-week :postgres (partial date-trunc :week) expr)) | |
(mu/defn ^:private quoted? [database-type :- ::lib.schema.common/non-blank-string]
(and (str/starts-with? database-type "\)
(str/ends-with? database-type "\))) | |
(defmethod sql.qp/->honeysql [:postgres :convert-timezone]
[driver [_ arg target-timezone source-timezone]]
(let [expr (sql.qp/->honeysql driver (cond-> arg
(string? arg) u.date/parse))
timestamptz? (h2x/is-of-type? expr "timestamptz")
_ (sql.u/validate-convert-timezone-args timestamptz? target-timezone source-timezone)
expr [:timezone target-timezone (if (not timestamptz?)
[:timezone source-timezone expr]
expr)]]
(h2x/with-database-type-info expr "timestamp"))) | |
(defmethod sql.qp/->honeysql [:postgres :value]
[driver value]
(let [[_ value {base-type :base_type, database-type :database_type}] value]
(when (some? value)
(condp #(isa? %2 %1) base-type
:type/UUID (when (not= "" value) ; support is-empty/non-empty checks
(UUID/fromString value))
:type/IPAddress (h2x/cast :inet value)
:type/PostgresEnum (if (quoted? database-type)
(h2x/cast database-type value)
(h2x/quoted-cast database-type value))
(sql.qp/->honeysql driver value))))) | |
(defmethod sql.qp/->honeysql [:postgres :median] [driver [_ arg]] (sql.qp/->honeysql driver [:percentile arg 0.5])) | |
(defmethod sql.qp/datetime-diff [:postgres :year]
[_driver _unit x y]
(let [interval [:age (date-trunc :day y) (date-trunc :day x)]]
(h2x/->integer (extract :year interval)))) | |
(defmethod sql.qp/datetime-diff [:postgres :quarter] [driver _unit x y] (h2x// (sql.qp/datetime-diff driver :month x y) 3)) | |
(defmethod sql.qp/datetime-diff [:postgres :month]
[_driver _unit x y]
(let [interval [:age (date-trunc :day y) (date-trunc :day x)]
year-diff (extract :year interval)
month-of-year-diff (extract :month interval)]
(h2x/->integer (h2x/+ month-of-year-diff (h2x/* year-diff 12))))) | |
(defmethod sql.qp/datetime-diff [:postgres :week] [driver _unit x y] (h2x// (sql.qp/datetime-diff driver :day x y) 7)) | |
(defmethod sql.qp/datetime-diff [:postgres :day]
[_driver _unit x y]
(let [interval (h2x/- (date-trunc :day y) (date-trunc :day x))]
(h2x/->integer (extract :day interval)))) | |
(defmethod sql.qp/datetime-diff [:postgres :hour] [driver _unit x y] (h2x// (sql.qp/datetime-diff driver :second x y) 3600)) | |
(defmethod sql.qp/datetime-diff [:postgres :minute] [driver _unit x y] (h2x// (sql.qp/datetime-diff driver :second x y) 60)) | |
(defmethod sql.qp/datetime-diff [:postgres :second]
[_driver _unit x y]
(let [seconds (h2x/- (extract-from-timestamp :epoch y) (extract-from-timestamp :epoch x))]
(h2x/->integer [:trunc seconds]))) | |
(defn- format-regex-match-first [_fn [identifier pattern]]
(let [[identifier-sql & identifier-args] (sql/format-expr identifier {:nested true})
[pattern-sql & pattern-args] (sql/format-expr pattern {:nested true})]
(into [(format "substring(%s FROM %s)" identifier-sql pattern-sql)]
cat
[identifier-args
pattern-args]))) | |
(sql/register-fn! ::regex-match-first #'format-regex-match-first) | |
(defmethod sql.qp/->honeysql [:postgres :regex-match-first]
[driver [_ arg pattern]]
(let [identifier (sql.qp/->honeysql driver arg)]
[::regex-match-first identifier pattern])) | |
(defmethod sql.qp/->honeysql [:postgres Time] [_ time-value] (h2x/->time time-value)) | |
(defn- format-pg-conversion [_fn [expr psql-type]]
(let [[expr-sql & expr-args] (sql/format-expr expr {:nested true})]
(into [(format "%s::%s" expr-sql (name psql-type))]
expr-args))) | |
(sql/register-fn! ::pg-conversion #'format-pg-conversion) | |
HoneySQL form that adds a Postgres-style (pg-conversion :myfield ::integer) -> HoneySQL -[Compile]-> "myfield"::integer | (defn- pg-conversion [expr psql-type] [::pg-conversion expr psql-type]) |
Create a Postgres text array literal from a sequence of elements. Used for the (sql/format-expr [::text-array "A" 1 "B" 2]) => ["array[?, 1, ?, 2]::text[]" "A" "B"] | (defn- format-text-array
[_fn [& elements]]
(let [elements (for [element elements]
(if (number? element)
[:inline element]
(name element)))
sql-args (map #(sql/format-expr % {:nested true}) elements)
sqls (map first sql-args)
args (mapcat rest sql-args)]
(into [(format "array[%s]::text[]" (str/join ", " sqls))]
args))) |
(sql/register-fn! ::text-array #'format-text-array) | |
e.g. ```clj [::json-query [::h2x/identifier :field ["boop" "bleh"]] "bigint" ["meh"]] => ["(boop.bleh#>> array[?]::text[])::bigint" "meh"] ``` | (defn- format-json-query
[_fn [parent-identifier field-type names]]
(let [names-text-array (into [::text-array] names)
[parent-id-sql & parent-id-args] (sql/format-expr parent-identifier {:nested true})
[path-sql & path-args] (sql/format-expr names-text-array {:nested true})]
(into [(format "(%s#>> %s)::%s" parent-id-sql path-sql field-type)]
cat
[parent-id-args path-args]))) |
(sql/register-fn! ::json-query #'format-json-query) | |
(defmethod sql.qp/json-query :postgres
[_driver unwrapped-identifier nfc-field]
(assert (h2x/identifier? unwrapped-identifier)
(format "Invalid identifier: %s" (pr-str unwrapped-identifier)))
(let [field-type (:database-type nfc-field)
nfc-path (:nfc-path nfc-field)
parent-identifier (sql.qp.u/nfc-field->parent-identifier unwrapped-identifier nfc-field)]
[::json-query parent-identifier field-type (rest nfc-path)])) | |
(defmethod sql.qp/->honeysql [:postgres :field]
[driver [_ id-or-name opts :as clause]]
(let [stored-field (when (integer? id-or-name)
(lib.metadata/field (qp.store/metadata-provider) id-or-name))
parent-method (get-method sql.qp/->honeysql [:sql :field])
identifier (parent-method driver clause)]
(cond
(= (:database-type stored-field) "money")
(pg-conversion identifier :numeric)
(lib.field/json-field? stored-field)
(if (::sql.qp/forced-alias opts)
(keyword (::add/source-alias opts))
(walk/postwalk #(if (h2x/identifier? %)
(sql.qp/json-query :postgres % stored-field)
%)
identifier))
:else
identifier))) | |
Postgres is not happy with JSON fields which are in group-bys or order-bys being described twice instead of using the alias. Therefore, force the alias, but only for JSON fields to avoid ambiguity. The alias names in JSON fields are unique wrt nfc path | (defmethod sql.qp/apply-top-level-clause
[:postgres :breakout]
[driver clause honeysql-form {breakout-fields :breakout, _fields-fields :fields :as query}]
(let [stored-field-ids (map second breakout-fields)
stored-fields (map #(when (integer? %)
(lib.metadata/field (qp.store/metadata-provider) %))
stored-field-ids)
parent-method (partial (get-method sql.qp/apply-top-level-clause [:sql :breakout])
driver clause honeysql-form)
qualified (parent-method query)
unqualified (parent-method (update query
:breakout
#(sql.qp/rewrite-fields-to-force-using-column-aliases % {:is-breakout true})))]
(if (some lib.field/json-field? stored-fields)
(merge qualified
(select-keys unqualified #{:group-by}))
qualified))) |
(defn- order-by-is-json-field?
[clause]
(let [is-aggregation? (= (-> clause (second) (first)) :aggregation)
stored-field-id (-> clause (second) (second))
stored-field (when (and (not is-aggregation?) (integer? stored-field-id))
(lib.metadata/field (qp.store/metadata-provider) stored-field-id))]
(and
(some? stored-field)
(lib.field/json-field? stored-field)))) | |
(defmethod sql.qp/->honeysql [:postgres :desc]
[driver clause]
(let [new-clause (if (order-by-is-json-field? clause)
(sql.qp/rewrite-fields-to-force-using-column-aliases clause)
clause)]
((get-method sql.qp/->honeysql [:sql :desc]) driver new-clause))) | |
(defmethod sql.qp/->honeysql [:postgres :asc]
[driver clause]
(let [new-clause (if (order-by-is-json-field? clause)
(sql.qp/rewrite-fields-to-force-using-column-aliases clause)
clause)]
((get-method sql.qp/->honeysql [:sql :asc]) driver new-clause))) | |
(defmethod unprepare/unprepare-value [:postgres Date] [_ value] (format "'%s'::timestamp" (u.date/format value))) | |
(prefer-method unprepare/unprepare-value [:sql Time] [:postgres Date]) | |
(defmethod unprepare/unprepare-value [:postgres UUID] [_ value] (format "'%s'::uuid" value)) | |
+----------------------------------------------------------------------------------------------------------------+ | metabase.driver.sql-jdbc impls | +----------------------------------------------------------------------------------------------------------------+ | |
Map of default Postgres column types -> Field base types. Add more mappings here as you come across them. | (def ^:private default-base-types
{:bigint :type/BigInteger
:bigserial :type/BigInteger
:bit :type/*
:bool :type/Boolean
:boolean :type/Boolean
:box :type/*
:bpchar :type/Text ; "blank-padded char" is the internal name of "character"
:bytea :type/* ; byte array
:cidr :type/Structured ; IPv4/IPv6 network address
:circle :type/*
:citext :type/Text ; case-insensitive text
:date :type/Date
:decimal :type/Decimal
:float4 :type/Float
:float8 :type/Float
:geometry :type/*
:inet :type/IPAddress
:int :type/Integer
:int2 :type/Integer
:int4 :type/Integer
:int8 :type/BigInteger
:interval :type/* ; time span
:json :type/JSON
:jsonb :type/JSON
:line :type/*
:lseg :type/*
:macaddr :type/Structured
:money :type/Decimal
:numeric :type/Decimal
:path :type/*
:pg_lsn :type/Integer ; PG Log Sequence #
:point :type/*
:real :type/Float
:serial :type/Integer
:serial2 :type/Integer
:serial4 :type/Integer
:serial8 :type/BigInteger
:smallint :type/Integer
:smallserial :type/Integer
:text :type/Text
:time :type/Time
:timetz :type/TimeWithLocalTZ
:timestamp :type/DateTime
:timestamptz :type/DateTimeWithLocalTZ
:tsquery :type/*
:tsvector :type/*
:txid_snapshot :type/*
:uuid :type/UUID
:varbit :type/*
:varchar :type/Text
:xml :type/Structured
(keyword "bit varying") :type/*
(keyword "character varying") :type/Text
(keyword "double precision") :type/Float
(keyword "time with time zone") :type/Time
(keyword "time without time zone") :type/Time
;; TODO postgres also supports `timestamp(p) with time zone` where p is the precision
;; maybe we should switch this to use `sql-jdbc.sync/pattern-based-database-type->base-type`
(keyword "timestamp with time zone") :type/DateTimeWithTZ
(keyword "timestamp without time zone") :type/DateTime}) |
(defmethod sql-jdbc.sync/database-type->base-type :postgres
[_driver column]
(if (contains? *enum-types* column)
:type/PostgresEnum
(default-base-types column))) | |
(defmethod sql-jdbc.sync/column->semantic-type :postgres
[_driver database-type _column-name]
;; this is really, really simple right now. if its postgres :json type then it's :type/SerializedJSON semantic-type
(case database-type
"json" :type/SerializedJSON
"jsonb" :type/SerializedJSON
"xml" :type/XML
"inet" :type/IPAddress
nil)) | |
If a value was uploaded for the SSL key, return whether it's using the PKCS-12 format. | (defn- pkcs-12-key-value?
[ssl-key-value]
(when ssl-key-value
(= (second (re-find secret/uploaded-base-64-prefix-pattern ssl-key-value))
"x-pkcs12"))) |
Builds the params to include in the JDBC connection spec for an SSL connection. | (defn- ssl-params
[{:keys [ssl-key-value] :as db-details}]
(let [ssl-root-cert (when (contains? #{"verify-ca" "verify-full"} (:ssl-mode db-details))
(secret/db-details-prop->secret-map db-details "ssl-root-cert"))
ssl-client-key (when (:ssl-use-client-auth db-details)
(secret/db-details-prop->secret-map db-details "ssl-key"))
ssl-client-cert (when (:ssl-use-client-auth db-details)
(secret/db-details-prop->secret-map db-details "ssl-client-cert"))
ssl-key-pw (when (:ssl-use-client-auth db-details)
(secret/db-details-prop->secret-map db-details "ssl-key-password"))
all-subprops (apply concat (map :subprops [ssl-root-cert ssl-client-key ssl-client-cert ssl-key-pw]))
has-value? (comp some? :value)]
(cond-> (set/rename-keys db-details {:ssl-mode :sslmode})
;; if somehow there was no ssl-mode set, just make it required (preserves existing behavior)
(nil? (:ssl-mode db-details))
(assoc :sslmode "require")
(has-value? ssl-root-cert)
(assoc :sslrootcert (secret/value->file! ssl-root-cert :postgres))
(has-value? ssl-client-key)
(assoc :sslkey (secret/value->file! ssl-client-key :postgres (when (pkcs-12-key-value? ssl-key-value) ".p12")))
(has-value? ssl-client-cert)
(assoc :sslcert (secret/value->file! ssl-client-cert :postgres))
;; Pass an empty string as password if none is provided; otherwise the driver will prompt for one
true
(assoc :sslpassword (or (secret/value->string ssl-key-pw) ""))
true
(as-> params ;; from outer cond->
(dissoc params :ssl-root-cert :ssl-root-cert-options :ssl-client-key :ssl-client-cert :ssl-key-password
:ssl-use-client-auth)
(apply dissoc params all-subprops))))) |
Params to include in the JDBC connection spec to disable SSL. | (def ^:private disable-ssl-params
{:sslmode "disable"}) |
(defmethod sql-jdbc.conn/connection-details->spec :postgres
[_ {ssl? :ssl, :as details-map}]
(let [props (-> details-map
(update :port (fn [port]
(if (string? port)
(Integer/parseInt port)
port)))
;; remove :ssl in case it's false; DB will still try (& fail) to connect if the key is there
(dissoc :ssl))
props (if ssl?
(let [ssl-prms (ssl-params details-map)]
;; if the user happened to specify any of the SSL options directly, allow those to take
;; precedence, but only if they match a key from our own
;; our `ssl-params` function is also removing various internal properties, ex: for secret resolution,
;; so we can't just merge the entire `props` map back in here because it will bring all those
;; internal property values back; only merge in the ones the driver might recognize
(merge ssl-prms (select-keys props (keys ssl-prms))))
(merge disable-ssl-params props))
props (as-> props it
(set/rename-keys it {:dbname :db})
(mdb.spec/spec :postgres it)
(sql-jdbc.common/handle-additional-options it details-map))]
props)) | |
(defmethod sql-jdbc.sync/excluded-schemas :postgres [_driver] #{"information_schema" "pg_catalog"}) | |
(defmethod sql-jdbc.execute/set-timezone-sql :postgres [_] "SET SESSION TIMEZONE TO %s;") | |
for some reason postgres | (defmethod sql-jdbc.execute/read-column-thunk [:postgres Types/TIMESTAMP]
[_ ^ResultSet rs ^ResultSetMetaData rsmeta ^Integer i]
(let [^Class klass (if (= (u/lower-case-en (.getColumnTypeName rsmeta i)) "timestamptz")
OffsetDateTime
LocalDateTime)]
(fn []
(.getObject rs i klass)))) |
Sometimes Postgres times come back as strings like | (defmethod sql-jdbc.execute/read-column-thunk [:postgres Types/TIME]
[driver ^ResultSet rs rsmeta ^Integer i]
(let [parent-thunk ((get-method sql-jdbc.execute/read-column-thunk [:sql-jdbc Types/TIME]) driver rs rsmeta i)]
(fn []
(try
(parent-thunk)
(catch Throwable e
(let [s (.getString rs i)]
(log/tracef e "Error in Postgres JDBC driver reading TIME value, fetching as string '%s'" s)
(u.date/parse s))))))) |
The postgres JDBC driver cannot properly read MONEY columns — see https://github.com/pgjdbc/pgjdbc/issues/425. Work
around this by checking whether the column type name is | (defmethod sql-jdbc.execute/read-column-thunk [:postgres Types/DOUBLE]
[_driver ^ResultSet rs ^ResultSetMetaData rsmeta ^Integer i]
(if (= (.getColumnTypeName rsmeta i) "money")
(fn []
(some-> (.getString rs i) u/parse-currency))
(fn []
(.getObject rs i)))) |
de-CLOB any CLOB values that come back | (defmethod sql-jdbc.execute/read-column-thunk :postgres
[_ ^ResultSet rs _ ^Integer i]
(fn []
(let [obj (.getObject rs i)]
(if (instance? org.postgresql.util.PGobject obj)
(.getValue ^org.postgresql.util.PGobject obj)
obj)))) |
Postgres doesn't support OffsetTime | (defmethod sql-jdbc.execute/set-parameter [:postgres OffsetTime]
[driver prepared-statement i t]
(let [local-time (t/local-time (t/with-offset-same-instant t (t/zone-offset 0)))]
(sql-jdbc.execute/set-parameter driver prepared-statement i local-time))) |
(defmethod driver/upload-type->database-type :postgres
[_driver upload-type]
(case upload-type
::upload/varchar-255 [[:varchar 255]]
::upload/text [:text]
::upload/int [:bigint]
::upload/auto-incrementing-int-pk [:bigserial :primary-key]
::upload/float [:float]
::upload/boolean [:boolean]
::upload/date [:date]
::upload/datetime [:timestamp]
::upload/offset-datetime [:timestamp-with-time-zone])) | |
(defmethod driver/table-name-length-limit :postgres [_driver] ;; https://www.postgresql.org/docs/current/sql-syntax-lexical.html#SQL-SYNTAX-IDENTIFIERS ;; This could be incorrect if Postgres has been compiled with a value for NAMEDATALEN other than the default (64), but ;; that seems unlikely and there's not an easy way to find out. 63) | |
(defn- format-copy [_clause table] [(str "COPY " (sql/format-entity table))]) | |
(sql/register-clause! ::copy format-copy :insert-into) | |
(defn- format-from-stdin [_clause delimiter] [(str "FROM STDIN NULL " delimiter)]) | |
(sql/register-clause! ::from-stdin format-from-stdin :from) | |
(defn- sanitize-value
;; Per https://www.postgresql.org/docs/current/sql-copy.html#id-1.9.3.55.9.2
;; "Backslash characters (\) can be used in the COPY data to quote data characters that might otherwise be taken as
;; row or column delimiters. In particular, the following characters must be preceded by a backslash if they appear
;; as part of a column value: backslash itself, newline, carriage return, and the current delimiter character."
[v]
(if (string? v)
(str/replace v #"\\|\n|\r|\t" {"\\" "\\\\"
"\n" "\\n"
"\r" "\\r"
"\t" "\\t"})
v)) | |
(defn- row->tsv
[row]
(->> row
(map sanitize-value)
(str/join "\t"))) | |
(defmethod driver/insert-into! :postgres
[driver db-id table-name column-names values]
(jdbc/with-db-transaction [conn (sql-jdbc.conn/db->pooled-connection-spec db-id)]
(let [copy-manager (CopyManager. (.unwrap ^Connection (:connection conn) PgConnection))
[sql & _] (sql/format {::copy (keyword table-name)
:columns (map keyword column-names)
::from-stdin "''"}
:quoted true
:dialect (sql.qp/quote-style driver))
;; On Postgres with a large file, 100 (3.76m) was significantly faster than 50 (4.03m) and 25 (4.27m). 1,000 was a
;; little faster but not by much (3.63m), and 10,000 threw an error:
;; PreparedStatement can have at most 65,535 parameters
chunks (partition-all (or driver/*insert-chunk-rows* 1000) values)]
(doseq [chunk chunks]
(let [tsvs (->> chunk
(map row->tsv)
(str/join "\n")
(StringReader.))]
(.copyIn copy-manager ^String sql tsvs)))))) | |
(defmethod driver/current-user-table-privileges :postgres
[_driver database]
(let [conn-spec (sql-jdbc.conn/db->pooled-connection-spec database)]
;; KNOWN LIMITATION: this won't return privileges for foreign tables, calling has_table_privilege on a foreign table
;; result in a operation not supported error
(->> (jdbc/query
conn-spec
(str/join
"\n"
["with table_privileges as ("
" select"
" NULL as role,"
" t.schemaname as schema,"
" t.objectname as table,"
" pg_catalog.has_table_privilege(current_user, '\"' || t.schemaname || '\"' || '.' || '\"' || t.objectname || '\"', 'UPDATE') as update,"
" pg_catalog.has_table_privilege(current_user, '\"' || t.schemaname || '\"' || '.' || '\"' || t.objectname || '\"', 'SELECT') as select,"
" pg_catalog.has_table_privilege(current_user, '\"' || t.schemaname || '\"' || '.' || '\"' || t.objectname || '\"', 'INSERT') as insert,"
" pg_catalog.has_table_privilege(current_user, '\"' || t.schemaname || '\"' || '.' || '\"' || t.objectname || '\"', 'DELETE') as delete"
" from ("
" select schemaname, tablename as objectname from pg_catalog.pg_tables"
" union"
" select schemaname, viewname as objectname from pg_catalog.pg_views"
" union"
" select schemaname, matviewname as objectname from pg_catalog.pg_matviews"
" ) t"
" where t.schemaname !~ '^pg_'"
" and t.schemaname <> 'information_schema'"
" and pg_catalog.has_schema_privilege(current_user, t.schemaname, 'USAGE')"
")"
"select t.*"
"from table_privileges t"]))
(filter #(or (:select %) (:update %) (:delete %) (:update %)))))) | |
------------------------------------------------- User Impersonation -------------------------------------------------- | |
(defmethod driver.sql/set-role-statement :postgres
[_ role]
(let [special-chars-pattern #"[^a-zA-Z0-9_]"
needs-quote (re-find special-chars-pattern role)]
(if needs-quote
(format "SET ROLE \"%s\";" role)
(format "SET ROLE %s;" role)))) | |
(defmethod driver.sql/default-database-role :postgres [_ _] "NONE") | |
Method impls for [[metabase.driver.sql-jdbc.actions]] for | (ns metabase.driver.postgres.actions (:require [clojure.java.jdbc :as jdbc] [clojure.string :as str] [metabase.actions.error :as actions.error] [metabase.driver.sql-jdbc.actions :as sql-jdbc.actions] [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn] [metabase.util :as u] [metabase.util.i18n :refer [deferred-trun tru]])) |
(set! *warn-on-reflection* true) | |
Given a constraint with TODO -- we should probably be TTL caching this information. Otherwise parsing 100 errors for a bulk action will result in 100 identical data warehouse queries. It's not like constraint columns are something we would expect to change regularly anyway. | (defn- constraint->column-names
[database constraint-name]
(let [jdbc-spec (sql-jdbc.conn/db->pooled-connection-spec (u/the-id database))
sql-args ["select column_name from information_schema.constraint_column_usage where constraint_name = ?" constraint-name]]
(into []
(map :column_name)
(jdbc/reducible-query jdbc-spec sql-args {:identifers identity, :transaction? false})))) |
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:postgres actions.error/violate-not-null-constraint]
[_driver error-type _database _action-type error-message]
(when-let [[_ column]
(re-find #"null value in column \"([^\"]+)\".*violates not-null constraint" error-message)]
{:type error-type
:message (tru "{0} must have values." (str/capitalize column))
:errors {column (tru "You must provide a value.")}})) | |
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:postgres actions.error/violate-unique-constraint]
[_driver error-type database _action-type error-message]
(when-let [[_match constraint _value]
(re-find #"duplicate key value violates unique constraint \"([^\"]+)\"" error-message)]
(let [columns (constraint->column-names database constraint)]
{:type error-type
:message (tru "{0} already {1}." (u/build-sentence (map str/capitalize columns) :stop? false) (deferred-trun "exists" "exist" (count columns)))
:errors (reduce (fn [acc col]
(assoc acc col (tru "This {0} value already exists." (str/capitalize col))))
{}
columns)}))) | |
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:postgres actions.error/violate-foreign-key-constraint]
[_driver error-type _database action-type error-message]
(or (when-let [[_match _table _constraint _ref-table column _value _ref-table-2]
(re-find #"update or delete on table \"([^\"]+)\" violates foreign key constraint \"([^\"]+)\" on table \"([^\"]+)\"\n Detail: Key \((.*?)\)=\((.*?)\) is still referenced from table \"([^\"]+)\"" error-message)]
(merge {:type error-type}
(case action-type
:row/delete
{:message (tru "Other tables rely on this row so it cannot be deleted.")
:errors {}}
:row/update
{:message (tru "Unable to update the record.")
:errors {column (tru "This {0} does not exist." (str/capitalize column))}})))
(when-let [[_match _table _constraint column _value _ref-table]
(re-find #"insert or update on table \"([^\"]+)\" violates foreign key constraint \"([^\"]+)\"\n Detail: Key \((.*?)\)=\((.*?)\) is not present in table \"([^\"]+)\"" error-message)]
{:type error-type
:message (case action-type
:row/create
(tru "Unable to create a new record.")
:row/update
(tru "Unable to update the record."))
:errors {column (tru "This {0} does not exist." (str/capitalize column))}}))) | |
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:postgres actions.error/incorrect-value-type]
[_driver error-type _database _action-type error-message]
(when-let [[_] (re-find #"invalid input syntax for .*" error-message)]
{:type error-type
:message (tru "Some of your values aren’t of the correct type for the database.")
:errors {}})) | |
(defmethod sql-jdbc.actions/base-type->sql-type-map :postgres
[_driver]
{:type/BigInteger "BIGINT"
:type/Boolean "BOOL"
:type/Date "DATE"
:type/DateTime "TIMESTAMP"
:type/DateTimeWithTZ "TIMESTAMP WITH TIME ZONE"
:type/DateTimeWithLocalTZ "TIMESTAMP WITH TIME ZONE"
:type/Decimal "DECIMAL"
:type/Float "FLOAT"
:type/Integer "INTEGER"
:type/IPAddress "INET"
:type/JSON "JSON"
:type/Text "TEXT"
:type/Time "TIME"
:type/TimeWithTZ "TIME WITH TIME ZONE"
:type/UUID "UUID"}) | |
For Postgres creating a Savepoint and rolling it back on error seems to be enough to let the parent transaction proceed if some particular statement encounters an error. | (defmethod sql-jdbc.actions/do-nested-transaction :postgres
[_driver ^java.sql.Connection conn thunk]
(let [savepoint (.setSavepoint conn)]
(try
(thunk)
(catch Throwable e
(.rollback conn savepoint)
(throw e))
(finally
(.releaseSavepoint conn savepoint))))) |
Add returning * so that we don't have to make an additional query. | (defmethod sql-jdbc.actions/prepare-query* [:postgres :row/create] [_driver _action hsql-query] (assoc hsql-query :returning [:*])) |
Result is already the created row. | (defmethod sql-jdbc.actions/select-created-row :postgres [_driver _create-hsql _conn result] result) |
(ns metabase.driver.postgres.ddl (:require [clojure.java.jdbc :as jdbc] [honey.sql :as sql] [java-time.api :as t] [metabase.driver.ddl.interface :as ddl.i] [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute] [metabase.driver.sql.ddl :as sql.ddl] [metabase.public-settings :as public-settings] [metabase.query-processor :as qp] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log])) | |
(set! *warn-on-reflection* true) | |
Must be called within a transaction.
Sets the current transaction This helps to address unexpectedly large/long running queries. | (defn- set-statement-timeout!
[tx]
(let [existing-timeout (->> #_{:clj-kondo/ignore [:discouraged-var]}
(sql/format {:select [:setting]
:from [:pg_settings]
:where [:= :name "statement_timeout"]}
{:quoted false})
(sql.ddl/jdbc-query tx)
first
:setting
parse-long)
ten-minutes (.toMillis (t/minutes 10))
new-timeout (if (zero? existing-timeout)
ten-minutes
(min ten-minutes existing-timeout))]
;; Can't use a prepared parameter with these statements
(sql.ddl/execute! tx [(format "SET LOCAL statement_timeout TO '%s'" (str new-timeout))]))) |
(defmethod ddl.i/refresh! :postgres
[driver database definition dataset-query]
(let [{:keys [query params]} (qp/compile dataset-query)]
(sql-jdbc.execute/do-with-connection-with-options
driver
database
{:write? true}
(fn [^java.sql.Connection conn]
(jdbc/with-db-transaction [tx {:connection conn}]
(set-statement-timeout! tx)
(sql.ddl/execute! tx [(sql.ddl/drop-table-sql database (:table-name definition))])
(sql.ddl/execute! tx (into [(sql.ddl/create-table-sql database definition query)] params)))
{:state :success})))) | |
(defmethod ddl.i/unpersist! :postgres
[driver database persisted-info]
(sql-jdbc.execute/do-with-connection-with-options
driver
database
{:write? true}
(fn [conn]
(try
(sql.ddl/execute! conn [(sql.ddl/drop-table-sql database (:table_name persisted-info))])
(catch Exception e
(log/warn e)
(throw e)))))) | |
(defmethod ddl.i/check-can-persist :postgres
[{driver :engine, :as database}]
(let [schema-name (ddl.i/schema-name database (public-settings/site-uuid))
table-name (format "persistence_check_%s" (rand-int 10000))
steps [[:persist.check/create-schema
(fn check-schema [conn]
(let [existing-schemas (->> ["select schema_name from information_schema.schemata"]
(sql.ddl/jdbc-query conn)
(map :schema_name)
(into #{}))]
(or (contains? existing-schemas schema-name)
(sql.ddl/execute! conn [(sql.ddl/create-schema-sql database)]))))]
[:persist.check/create-table
(fn create-table [conn]
(sql.ddl/execute! conn [(sql.ddl/create-table-sql database
{:table-name table-name
:field-definitions [{:field-name "field"
:base-type :type/Text}]}
"select 1")]))]
[:persist.check/read-table
(fn read-table [conn]
(sql.ddl/jdbc-query conn [(format "select * from %s.%s"
schema-name table-name)]))]
[:persist.check/delete-table
(fn delete-table [conn]
(sql.ddl/execute! conn [(sql.ddl/drop-table-sql database table-name)]))]
[:persist.check/create-kv-table
(fn create-kv-table [conn]
(sql.ddl/execute! conn [(format "drop table if exists %s.cache_info"
schema-name)])
(sql.ddl/execute! conn (sql/format
(ddl.i/create-kv-table-honey-sql-form schema-name)
{:dialect :ansi})))]
[:persist.check/populate-kv-table
(fn create-kv-table [conn]
(sql.ddl/execute! conn (sql/format
(ddl.i/populate-kv-table-honey-sql-form
schema-name)
{:dialect :ansi})))]]]
(sql-jdbc.execute/do-with-connection-with-options
driver
database
{:write? true}
(fn [^java.sql.Connection conn]
(jdbc/with-db-transaction
[tx {:connection conn}]
(set-statement-timeout! tx)
(loop [[[step stepfn] & remaining] steps]
(let [result (try (stepfn tx)
(log/info (trs "Step {0} was successful for db {1}"
step (:name database)))
::valid
(catch Exception e
(log/warn (trs "Error in `{0}` while checking for model persistence permissions." step))
(log/warn e)
step))]
(cond (and (= result ::valid) remaining)
(recur remaining)
(= result ::valid)
[true :persist.check/valid]
:else [false step])))))))) | |
Shared code for all drivers that use SQL under the hood. | (ns metabase.driver.sql
(:require
[metabase.driver :as driver]
[metabase.driver.common.parameters.parse :as params.parse]
[metabase.driver.common.parameters.values :as params.values]
[metabase.driver.sql.parameters.substitute :as sql.params.substitute]
[metabase.driver.sql.parameters.substitution
:as sql.params.substitution]
[metabase.driver.sql.query-processor :as sql.qp]
[metabase.driver.sql.util :as sql.u]
[metabase.driver.sql.util.unprepare :as unprepare]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[potemkin :as p])) |
(comment sql.params.substitution/keep-me) ; this is so `cljr-clean-ns` and the linter don't remove the `:require` | |
(driver/register! :sql, :abstract? true) | |
(doseq [feature [:standard-deviation-aggregations
:foreign-keys
:expressions
:expression-aggregations
:native-parameters
:nested-queries
:binning
:advanced-math-expressions
:percentile-aggregations
:regex]]
(defmethod driver/database-supports? [:sql feature] [_driver _feature _db] true)) | |
(doseq [join-feature [:left-join
:right-join
:inner-join
:full-join]]
(defmethod driver/database-supports? [:sql join-feature]
[driver _feature db]
(driver/database-supports? driver :foreign-keys db))) | |
(defmethod driver/database-supports? [:sql :persist-models-enabled]
[driver _feat db]
(and
(driver/database-supports? driver :persist-models db)
(-> db :settings :persist-models-enabled))) | |
(defmethod driver/mbql->native :sql [driver query] (sql.qp/mbql->native driver query)) | |
(defmethod driver/prettify-native-form :sql [driver native-form] (sql.u/format-sql-and-fix-params driver native-form)) | |
(mu/defmethod driver/substitute-native-parameters :sql
[_driver {:keys [query] :as inner-query} :- [:and [:map-of :keyword :any] [:map {:query ms/NonBlankString}]]]
(let [[query params] (-> query
params.parse/parse
(sql.params.substitute/substitute (params.values/query->params-map inner-query)))]
(assoc inner-query
:query query
:params params))) | |
| (defmethod driver/splice-parameters-into-native-query :sql
[driver {:keys [params], sql :query, :as query}]
(cond-> query
(seq params)
(merge {:params nil
:query (unprepare/unprepare driver (cons sql params))}))) |
+----------------------------------------------------------------------------------------------------------------+ | Connection Impersonation | +----------------------------------------------------------------------------------------------------------------+ | |
SQL for setting the active role for a connection, such as USE ROLE or equivalent, for the given driver. | (defmulti set-role-statement
{:added "0.47.0" :arglists '([driver role])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(defmethod set-role-statement :default [_ _ _] nil) | |
The name of the default role for a given database, used for queries that do not have custom user impersonation rules configured for them. This must be implemented for each driver that supports user impersonation. | (defmulti default-database-role
{:added "0.47.0" :arglists '(^String [driver database])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(defmethod default-database-role :default [_ _database] nil) | |
+----------------------------------------------------------------------------------------------------------------+ | Convenience Imports | +----------------------------------------------------------------------------------------------------------------+ | |
(p/import-vars [sql.params.substitution ->prepared-substitution PreparedStatementSubstitution]) | |
TODO - we should add imports for | |
Shared code for drivers for SQL databases using their respective JDBC drivers under the hood. | (ns metabase.driver.sql-jdbc (:require [clojure.java.jdbc :as jdbc] [honey.sql :as sql] [metabase.driver :as driver] [metabase.driver.sql :as driver.sql] [metabase.driver.sql-jdbc.actions :as sql-jdbc.actions] [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn] [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute] [metabase.driver.sql-jdbc.sync :as sql-jdbc.sync] [metabase.driver.sql-jdbc.sync.interface :as sql-jdbc.sync.interface] [metabase.driver.sql.query-processor :as sql.qp] [metabase.driver.sync :as driver.s] [metabase.query-processor.writeback :as qp.writeback] [metabase.util.honey-sql-2 :as h2x]) (:import (java.sql Connection))) |
(set! *warn-on-reflection* true) | |
(comment sql-jdbc.actions/keep-me) | |
(driver/register! :sql-jdbc, :parent :sql, :abstract? true) | |
+----------------------------------------------------------------------------------------------------------------+ | Run a Query | +----------------------------------------------------------------------------------------------------------------+ | |
Execute a TODO - Seems like this is only used in a handful of places, consider moving to util namespace | (defn query
([driver database honeysql-form]
(jdbc/query (sql-jdbc.conn/db->pooled-connection-spec database)
(sql.qp/format-honeysql driver honeysql-form)))
([driver database table honeysql-form]
(let [table-identifier (sql.qp/->honeysql driver (h2x/identifier :table (:schema table) (:name table)))]
(query driver database (merge {:from [[table-identifier]]}
honeysql-form))))) |
+----------------------------------------------------------------------------------------------------------------+ | Default SQL JDBC metabase.driver impls | +----------------------------------------------------------------------------------------------------------------+ | |
(defmethod driver/can-connect? :sql-jdbc [driver details] (sql-jdbc.conn/can-connect? driver details)) | |
(defmethod driver/table-rows-seq :sql-jdbc
[driver database table]
(query driver database table {:select [:*]})) | |
(defn- has-method? [driver multifn]
{:pre [(keyword? driver)]}
(when-let [driver-method (get-method multifn driver)]
(and driver-method
(not (identical? driver-method (get-method multifn :sql-jdbc)))
(not (identical? driver-method (get-method multifn :default)))))) | |
TODO - this implementation should itself be deprecated! And have drivers implement it directly instead. | (defmethod driver/database-supports? [:sql-jdbc :set-timezone] [driver _feature _db] (boolean (seq (sql-jdbc.execute/set-timezone-sql driver)))) |
(defmethod driver/db-default-timezone :sql-jdbc
[driver database]
;; if the driver has a non-default implementation of [[sql-jdbc.sync/db-default-timezone]], use that.
#_{:clj-kondo/ignore [:deprecated-var]}
(if (has-method? driver sql-jdbc.sync/db-default-timezone)
(sql-jdbc.sync/db-default-timezone driver (sql-jdbc.conn/db->pooled-connection-spec database))
;; otherwise fall back to the default implementation.
((get-method driver/db-default-timezone :metabase.driver/driver) driver database))) | |
(defmethod driver/execute-reducible-query :sql-jdbc [driver query chans respond] (sql-jdbc.execute/execute-reducible-query driver query chans respond)) | |
(defmethod driver/notify-database-updated :sql-jdbc [_ database] (sql-jdbc.conn/invalidate-pool-for-db! database)) | |
(defmethod driver/dbms-version :sql-jdbc [driver database] (sql-jdbc.sync/dbms-version driver (sql-jdbc.conn/db->pooled-connection-spec database))) | |
(defmethod driver/describe-database :sql-jdbc [driver database] (sql-jdbc.sync/describe-database driver database)) | |
(defmethod driver/describe-table :sql-jdbc [driver database table] (sql-jdbc.sync/describe-table driver database table)) | |
(defmethod driver/describe-table-fks :sql-jdbc [driver database table] (sql-jdbc.sync/describe-table-fks driver database table)) | |
(defmethod driver/describe-table-indexes :sql-jdbc [driver database table] (sql-jdbc.sync/describe-table-indexes driver database table)) | |
(defmethod sql.qp/cast-temporal-string [:sql-jdbc :Coercion/ISO8601->DateTime] [_driver _semantic_type expr] (h2x/->timestamp expr)) | |
(defmethod sql.qp/cast-temporal-string [:sql-jdbc :Coercion/ISO8601->Date] [_driver _semantic_type expr] (h2x/->date expr)) | |
(defmethod sql.qp/cast-temporal-string [:sql-jdbc :Coercion/ISO8601->Time] [_driver _semantic_type expr] (h2x/->time expr)) | |
(defmethod sql.qp/cast-temporal-string [:sql-jdbc :Coercion/YYYYMMDDHHMMSSString->Temporal] [_driver _semantic_type expr] (h2x/->timestamp expr)) | |
(defn- create-table-sql
[driver table-name col->type]
(first (sql/format {:create-table (keyword table-name)
:with-columns (map (fn [[name type-spec]]
(vec (cons name type-spec)))
col->type)}
:quoted true
:dialect (sql.qp/quote-style driver)))) | |
(defmethod driver/create-table! :sql-jdbc
[driver db-id table-name col->type]
(let [sql (create-table-sql driver table-name col->type)]
(qp.writeback/execute-write-sql! db-id sql))) | |
(defmethod driver/drop-table! :sql-jdbc
[driver db-id table-name]
(let [sql (first (sql/format {:drop-table [:if-exists (keyword table-name)]}
:quoted true
:dialect (sql.qp/quote-style driver)))]
(qp.writeback/execute-write-sql! db-id sql))) | |
(defmethod driver/insert-into! :sql-jdbc
[driver db-id table-name column-names values]
(let [table-name (keyword table-name)
columns (map keyword column-names)
;; We need to partition the insert into multiple statements for both performance and correctness.
;;
;; On Postgres with a large file, 100 (3.76m) was significantly faster than 50 (4.03m) and 25 (4.27m). 1,000 was a
;; little faster but not by much (3.63m), and 10,000 threw an error:
;; PreparedStatement can have at most 65,535 parameters
;; One imagines that `(long (/ 65535 (count columns)))` might be best, but I don't trust the 65K limit to apply
;; across all drivers. With that in mind, 100 seems like a safe compromise.
;; There's nothing magic about 100, but it felt good in testing. There could well be a better number.
chunks (partition-all (or driver/*insert-chunk-rows* 100) values)
sqls (map #(sql/format {:insert-into table-name
:columns columns
:values %}
:quoted true
:dialect (sql.qp/quote-style driver))
chunks)]
(jdbc/with-db-transaction [conn (sql-jdbc.conn/db->pooled-connection-spec db-id)]
(doseq [sql sqls]
(jdbc/execute! conn sql))))) | |
(defmethod driver/add-columns! :sql-jdbc
[driver db-id table-name col->type]
(let [sql (first (sql/format {:alter-table (keyword table-name)
:add-column (map (fn [[name type-spec]]
(vec (cons name type-spec)))
col->type)}
:quoted true
:dialect (sql.qp/quote-style driver)))]
(qp.writeback/execute-write-sql! db-id sql))) | |
(defmethod driver/syncable-schemas :sql-jdbc
[driver database]
(sql-jdbc.execute/do-with-connection-with-options
driver
database
nil
(fn [^java.sql.Connection conn]
(let [[inclusion-patterns
exclusion-patterns] (driver.s/db-details->schema-filter-patterns database)]
(into #{} (sql-jdbc.sync.interface/filtered-syncable-schemas driver conn (.getMetaData conn) inclusion-patterns exclusion-patterns)))))) | |
(defmethod driver/set-role! :sql-jdbc
[driver conn role]
(let [sql (driver.sql/set-role-statement driver role)]
(with-open [stmt (.createStatement ^Connection conn)]
(.execute stmt sql)))) | |
(ns metabase.driver.sql-jdbc.actions (:require [clojure.java.jdbc :as jdbc] [clojure.set :as set] [clojure.string :as str] [flatland.ordered.set :as ordered-set] [medley.core :as m] [metabase.actions :as actions] [metabase.driver :as driver] [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute] [metabase.driver.sql.query-processor :as sql.qp] [metabase.driver.util :as driver.u] [metabase.lib.metadata.protocols :as lib.metadata.protocols] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.id :as lib.schema.id] [metabase.query-processor :as qp] [metabase.query-processor.store :as qp.store] [metabase.util :as u] [metabase.util.honey-sql-2 :as h2x] [metabase.util.i18n :refer [trs tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [schema.core :as s]) (:import (java.sql Connection SQLException))) | |
(set! *warn-on-reflection* true) | |
+----------------------------------------------------------------------------------------------------------------+ | Error handling | +----------------------------------------------------------------------------------------------------------------+ | |
Try to parse the SQL error message returned by JDBC driver. The methods should returns a map of: - type: the error type. Check [[metabase.actions.error]] for the full list - message: a nice message summarized of what went wrong - errors: a map from field-name => sepcific error message. This is used by UI to display per fields error If non per-column error is available, returns an empty map. Or return | (defmulti maybe-parse-sql-error
{:changelog-test/ignore true, :arglists '([driver error-type database action-type error-message]), :added "0.48.0"}
(fn [driver error-type _database _action-type _error-message]
[(driver/dispatch-on-initialized-driver driver) error-type])
:hierarchy #'driver/hierarchy) |
(defmethod maybe-parse-sql-error :default [_driver _error-type _database _e] nil) | |
(defn- parse-sql-error
[driver database action-type e]
(let [parsers-for-driver (keep (fn [[[method-driver error-type] method]]
(when (= method-driver driver)
(partial method driver error-type)))
(dissoc (methods maybe-parse-sql-error) :default))]
(try
(some #(% database action-type (ex-message e)) parsers-for-driver)
;; Catch errors in parse-sql-error and log them so more errors in the future don't break the entire action.
;; We'll still get the original unparsed error message.
(catch Throwable new-e
(log/error new-e (trs "Error parsing SQL error message {0}: {1}" (pr-str (ex-message e)) (ex-message new-e)))
nil)))) | |
(defn- do-with-auto-parse-sql-error
[driver database action thunk]
(try
(thunk)
(catch SQLException e
(throw (ex-info (or (ex-message e) "Error executing action.")
(merge (or (some-> (parse-sql-error driver database action e)
;; the columns in error message should match with columns
;; in the parameter. It's usually got from calling
;; GET /api/action/:id/execute, and in there all column names are slugified
(m/update-existing :errors update-keys u/slugify))
(assoc (ex-data e) :message (ex-message e)))
{:status-code 400})))))) | |
Execute body and if there is an exception, try to parse the error message to search for known sql errors then throw a regular (and easier to understand/process) exception. | (defmacro ^:private with-auto-parse-sql-exception [driver database action-type & body] `(do-with-auto-parse-sql-error ~driver ~database ~action-type (fn [] ~@body))) |
(defn- mbql-query->raw-hsql
[driver {database-id :database, :as query}]
(qp.store/with-metadata-provider database-id
;; catch errors in the query
(qp/preprocess query)
(sql.qp/mbql->honeysql driver query))) | |
+----------------------------------------------------------------------------------------------------------------+ | Action Execution | +----------------------------------------------------------------------------------------------------------------+ | |
Return a map of [[metabase.types]] type to SQL string type name. Used for casting. Looks like we're just copypasting this from implementations of [[metabase.test.data.sql/field-base-type->sql-type]] so go find that stuff if you need to write more implementations for this. | (defmulti base-type->sql-type-map
{:changelog-test/ignore true, :arglists '([driver]), :added "0.44.0"}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Certain value types need to have their honeysql form updated to work properly during update/creation. This function uses honeysql casting to wrap values in the map that need to be cast with their column's type, and passes through types that do not need casting like integer or string. | (defn- cast-values
[driver column->value database-id table-id]
(let [type->sql-type (base-type->sql-type-map driver)
column->field (actions/cached-value
[::cast-values table-id]
(fn []
(into {}
#_{:clj-kondo/ignore [:deprecated-var]}
(map (juxt :name qp.store/->legacy-metadata))
(qp.store/with-metadata-provider database-id
(lib.metadata.protocols/fields (qp.store/metadata-provider) table-id)))))]
(m/map-kv-vals (fn [col-name value]
(let [col-name (u/qualified-name col-name)
{base-type :base_type :as field} (get column->field col-name)]
(if-let [sql-type (type->sql-type base-type)]
(h2x/cast sql-type value)
(try
(sql.qp/->honeysql driver [:value value field])
(catch Exception e
(throw (ex-info (str "column cast failed: " (pr-str col-name))
{:column col-name
:status-code 400}
e)))))))
column->value))) |
Data warehouse JDBC Connection to use for doing CRUD Actions. Bind this to reuse the same Connection/transaction throughout a single bulk Action. | (def ^:private ^:dynamic ^Connection *connection* nil) |
Impl function for [[with-jdbc-transaction]]. Why not just use [[jdbc/with-db-transaction]] to do this stuff? Why reinvent the wheel? There are a few reasons:
| (defn do-with-jdbc-transaction
[database-id f]
(if *connection*
(f *connection*)
(let [driver (driver.u/database->driver database-id)]
(sql-jdbc.execute/do-with-connection-with-options
driver
database-id
{:write? true}
(fn [^Connection conn]
;; execute inside of a transaction.
(.setAutoCommit conn false)
(log/tracef "BEGIN transaction on conn %s@0x%s" (.getCanonicalName (class conn)) (System/identityHashCode conn))
(try
(let [result (binding [*connection* conn]
(f conn))]
(log/debug "f completed successfully; committing transaction.")
(log/tracef "COMMIT transaction on conn %s@0x%s" (.getCanonicalName (class conn)) (System/identityHashCode conn))
(.commit conn)
result)
(catch Throwable e
(log/debugf "f threw Exception; rolling back transaction. Error: %s" (ex-message e))
(log/tracef "ROLLBACK transaction on conn %s@0x%s" (.getCanonicalName (class conn)) (System/identityHashCode conn))
(.rollback conn)
(throw e)))))))) |
Execute | (defmacro with-jdbc-transaction
{:style/indent 1}
[[connection-binding database-id] & body]
`(do-with-jdbc-transaction ~database-id (fn [~(vary-meta connection-binding assoc :tag 'Connection)] ~@body))) |
Multimethod for preparing a honeysql query | (defmulti prepare-query*
{:changelog-test/ignore true, :arglists '([driver action hsql-query]), :added "0.46.0"}
(fn [driver action _]
[(driver/dispatch-on-initialized-driver driver)
(keyword action)])
:hierarchy #'driver/hierarchy) |
(defmethod prepare-query* :default [_driver _action hsql-query] hsql-query) | |
(defn- prepare-query [hsql-query driver action] (prepare-query* driver action hsql-query)) | |
(defmethod actions/perform-action!* [:sql-jdbc :row/delete]
[driver action database {database-id :database, :as query}]
(let [raw-hsql (mbql-query->raw-hsql driver query)
delete-hsql (-> raw-hsql
(dissoc :select)
(assoc :delete [])
(prepare-query driver action))
sql-args (sql.qp/format-honeysql driver delete-hsql)]
(with-jdbc-transaction [conn database-id]
;; TODO -- this should probably be using [[metabase.driver/execute-write-query!]]
(let [rows-deleted (with-auto-parse-sql-exception driver database action
(first (jdbc/execute! {:connection conn} sql-args {:transaction? false})))]
(when-not (= rows-deleted 1)
(throw (ex-info (if (zero? rows-deleted)
(tru "Sorry, the row you''re trying to delete doesn''t exist")
(tru "Sorry, this would delete {0} rows, but you can only act on 1" rows-deleted))
{:staus-code 400})))
{:rows-deleted [1]})))) | |
(defmethod actions/perform-action!* [:sql-jdbc :row/update]
[driver action database {database-id :database :keys [update-row] :as query}]
(let [update-row (update-keys update-row keyword)
raw-hsql (mbql-query->raw-hsql driver query)
target-table (first (:from raw-hsql))
update-hsql (-> raw-hsql
(select-keys [:where])
(assoc :update target-table
:set (cast-values driver update-row database-id (get-in query [:query :source-table])))
(prepare-query driver action))
sql-args (sql.qp/format-honeysql driver update-hsql)]
(with-jdbc-transaction [conn database-id]
;; TODO -- this should probably be using [[metabase.driver/execute-write-query!]]
(let [rows-updated (with-auto-parse-sql-exception driver database action
(first (jdbc/execute! {:connection conn} sql-args {:transaction? false})))]
(when-not (= rows-updated 1)
(throw (ex-info (if (zero? rows-updated)
(tru "Sorry, the row you''re trying to update doesn''t exist")
(tru "Sorry, this would update {0} rows, but you can only act on 1" rows-updated))
{:staus-code 400})))
{:rows-updated [1]})))) | |
Multimethod for converting the result of an insert into the created row.
| (defmulti select-created-row
{:changelog-test/ignore true, :arglists '([driver create-hsql conn result]), :added "0.46.0"}
(fn [driver _ _ _]
(driver/dispatch-on-initialized-driver driver))
:hierarchy #'driver/hierarchy) |
H2 and MySQL are dumb and | (defmethod select-created-row :default
[driver create-hsql conn result]
(let [select-hsql (-> create-hsql
(dissoc :insert-into :values)
(assoc :select [:*]
:from [(:insert-into create-hsql)]
;; :and with a single clause will be optimized in HoneySQL
:where (into [:and]
(for [[col val] result]
[:= (keyword col) val]))))
select-sql-args (sql.qp/format-honeysql driver select-hsql)]
(log/tracef ":row/create SELECT HoneySQL:\n\n%s" (u/pprint-to-str select-hsql))
(log/tracef ":row/create SELECT SQL + args:\n\n%s" (u/pprint-to-str select-sql-args))
(first (jdbc/query {:connection conn} select-sql-args {:identifiers identity, :transaction? false})))) |
(defmethod actions/perform-action!* [:sql-jdbc :row/create]
[driver action database {database-id :database :keys [create-row] :as query}]
(let [create-row (update-keys create-row keyword)
raw-hsql (mbql-query->raw-hsql driver query)
create-hsql (-> raw-hsql
(assoc :insert-into (first (:from raw-hsql)))
(assoc :values [(cast-values driver create-row database-id (get-in query [:query :source-table]))])
(dissoc :select :from)
(prepare-query driver action))
sql-args (sql.qp/format-honeysql driver create-hsql)]
(log/tracef ":row/create HoneySQL:\n\n%s" (u/pprint-to-str create-hsql))
(log/tracef ":row/create SQL + args:\n\n%s" (u/pprint-to-str sql-args))
(with-jdbc-transaction [conn database-id]
(let [result (with-auto-parse-sql-exception driver database action
(jdbc/execute! {:connection conn} sql-args {:return-keys true, :identifiers identity, :transaction? false}))
_ (log/tracef ":row/create INSERT returned\n\n%s" (u/pprint-to-str result))
row (select-created-row driver create-hsql conn result)]
(log/tracef ":row/create returned row %s" (pr-str row))
{:created-row row})))) | |
Bulk actions | |
Execute Why do we need this? With things like bulk insert, we want to collect all the errors for all the rows in one go. Say you have 4 rows, 1 2 3 and 4. If 1 errors then depending on the DBMS, the transaction enters an error state that disallows doing anything else. 2, 3, and 4 will error with a "transaction has been aborted" error that you can't clear (AFAIK). This affects Postgres but not H2. Not sure about other DBs yet. Without using nested transactions, if you have errors in rows 2 and 4 you'd only see the error in row 2 since 3 and 4 would fail with "transaction has been aborted" or whatever. So the point of using nested transactions is that if 2 is done inside a nested transaction we can rollback the nested transaction which allows the top-level transaction to proceed even tho part of it errored. | (defmulti do-nested-transaction
{:changelog-test/ignore true :arglists '([driver ^java.sql.Connection connection thunk]), :added "0.44.0"}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(defn- perform-bulk-action-with-repeated-single-row-actions!
[{:keys [driver database action rows xform]
:or {xform identity}}]
(assert (seq rows))
(with-jdbc-transaction [conn (u/the-id database)]
(transduce
(comp xform (m/indexed))
(fn
([]
[[] []])
([[errors successes]]
(when (seq errors)
(.rollback conn))
[errors successes])
([[errors successes] [row-index arg-map]]
(try
(let [result (do-nested-transaction
driver
conn
(fn []
(actions/perform-action!* driver action database arg-map)))]
[errors
(conj successes result)])
(catch Throwable e
[(conj errors {:index row-index, :error (ex-message e)})
successes]))))
rows))) | |
| |
(defmethod actions/perform-action!* [:sql-jdbc :bulk/create]
[driver _action database {:keys [table-id rows]}]
(log/tracef "Inserting %d rows" (count rows))
(perform-bulk-action-with-repeated-single-row-actions!
{:driver driver
:database database
:action :row/create
:rows rows
:xform (comp (map (fn [row]
{:database (u/the-id database)
:type :query
:query {:source-table table-id}
:create-row row}))
#(completing % (fn [[errors successes]]
(when (seq errors)
(throw (ex-info (tru "Error(s) inserting rows.")
{:status-code 400, :errors errors})))
{:created-rows (map :created-row successes)})))})) | |
Shared stuff for both | |
(mu/defn ^:private table-id->pk-field-name->id :- [:map-of ::lib.schema.common/non-blank-string ::lib.schema.id/field]
"Given a `table-id` return a map of string Field name -> Field ID for the primary key columns for that Table."
[database-id :- ::lib.schema.id/database
table-id :- ::lib.schema.id/table]
(into {}
(comp (filter (fn [{:keys [semantic-type], :as _field}]
(isa? semantic-type :type/PK)))
(map (juxt :name :id)))
(qp.store/with-metadata-provider database-id
(lib.metadata.protocols/fields
(qp.store/metadata-provider)
table-id)))) | |
Given [[field-name->id]] as returned by [[table-id->pk-field-name->id]] or similar and a | (defn- row->mbql-filter-clause
[field-name->id row]
(when (empty? row)
(throw (ex-info (tru "Cannot build filter clause: row cannot be empty.")
{:field-name->id field-name->id, :row row, :status-code 400})))
(into [:and] (for [[field-name value] row
:let [field-id (get field-name->id (u/qualified-name field-name))
;; if the field isn't in `field-name->id` then it's an error in our code. Not
;; i18n'ed because this is not something that should be User facing unless our
;; backend code is broken.
;;
;; Unknown column names in user input WILL NOT trigger this error.
;; [[row->mbql-filter-clause]] is only used for *known* PK columns that are
;; used for the MBQL `:filter` clause. Unknown columns will trigger an error in
;; the DW but not here.
_ (assert field-id
(format "Field %s is not present in field-name->id map"
(pr-str field-name)))]]
[:= [:field field-id nil] value]))) |
| |
Make sure all | (defn- check-rows-have-expected-columns-and-no-other-keys
[rows expected-columns]
;; we only actually need to check the first map since [[check-consistent-row-keys]] should have checked that
;; they all have the same keys.
(let [expected-columns (set expected-columns)
actual-columns (set (keys (first rows)))]
(when-not (= actual-columns expected-columns)
(throw (ex-info (tru "Rows have the wrong columns: expected {0}, but got {1}" expected-columns actual-columns)
{:status-code 400, :expected-columns expected-columns, :actual-columns actual-columns}))))) |
Make sure all | (defn- check-consistent-row-keys
[rows]
(let [all-row-column-sets (reduce
(fn [seen-set row]
(conj seen-set (set (keys row))))
#{}
rows)]
(when (> (count all-row-column-sets) 1)
(throw (ex-info (tru "Some rows have different sets of columns: {0}"
(str/join ", " (map pr-str all-row-column-sets)))
{:status-code 400, :column-sets all-row-column-sets}))))) |
Make sure all | (defn- check-unique-rows
[rows]
(when-let [repeats (not-empty
(into
;; ordered set so the results are deterministic for test purposes
(ordered-set/ordered-set)
(filter (fn [[_row repeat-count]]
(> repeat-count 1)))
(frequencies rows)))]
(throw (ex-info (tru "Rows need to be unique: repeated rows {0}"
(str/join ", " (for [[row repeat-count] repeats]
(format "%s × %d" (pr-str row) repeat-count))))
{:status-code 400, :repeated-rows repeats})))) |
(defmethod actions/perform-action!* [:sql-jdbc :bulk/delete]
[driver _action {database-id :id, :as database} {:keys [table-id rows]}]
(log/tracef "Deleting %d rows" (count rows))
(let [pk-name->id (table-id->pk-field-name->id database-id table-id)]
;; validate the keys in `rows`
(check-consistent-row-keys rows)
(check-rows-have-expected-columns-and-no-other-keys rows (keys pk-name->id))
(check-unique-rows rows)
;; now do one `:row/delete` for each row
(perform-bulk-action-with-repeated-single-row-actions!
{:driver driver
:database database
:action :row/delete
:rows rows
:xform (comp (map (fn [row]
{:database database-id
:type :query
:query {:source-table table-id
:filter (row->mbql-filter-clause pk-name->id row)}}))
#(completing % (fn [[errors _successes]]
(when (seq errors)
(throw (ex-info (tru "Error(s) deleting rows.")
{:status-code 400, :errors errors})))
;; `:bulk/delete` just returns a simple status message on success.
{:success true})))}))) | |
| |
Return a 400 if | (s/defn ^:private check-row-has-all-pk-columns
[row :- {s/Str s/Any} pk-names :- #{s/Str}]
(doseq [pk-key pk-names
:when (not (contains? row pk-key))]
(throw (ex-info (tru "Row is missing required primary key column. Required {0}; got {1}"
(pr-str pk-names)
(pr-str (set (keys row))))
{:row row, :pk-names pk-names, :status-code 400})))) |
Return a 400 if | (s/defn ^:private check-row-has-some-non-pk-columns
[row :- {s/Str s/Any} pk-names :- #{s/Str}]
(let [non-pk-names (set/difference (set (keys row)) pk-names)]
(when (empty? non-pk-names)
(throw (ex-info (tru "Invalid update row map: no non-PK columns. Got {0}, all of which are PKs."
(pr-str (set (keys row))))
{:status-code 400
:row row
:all-keys (set (keys row))
:pk-names pk-names}))))) |
Create a function to use to transform each row coming in to a | (defn- bulk-update-row-xform
[{database-id :id, :as _database} table-id]
;; TODO -- make sure all rows specify the PK columns
(let [pk-name->id (table-id->pk-field-name->id database-id table-id)
pk-names (set (keys pk-name->id))]
(fn [row]
(check-row-has-all-pk-columns row pk-names)
(let [pk-column->value (select-keys row pk-names)]
(check-row-has-some-non-pk-columns row pk-names)
{:database database-id
:type :query
:query {:source-table table-id
:filter (row->mbql-filter-clause pk-name->id pk-column->value)}
:update-row (apply dissoc row pk-names)})))) |
(defmethod actions/perform-action!* [:sql-jdbc :bulk/update]
[driver _action database {:keys [table-id rows]}]
(log/tracef "Updating %d rows" (count rows))
(perform-bulk-action-with-repeated-single-row-actions!
{:driver driver
:database database
:action :row/update
:rows rows
:xform (comp (map (bulk-update-row-xform database table-id))
#(completing % (fn [[errors successes]]
(when (seq errors)
(throw (ex-info (tru "Error(s) updating rows.")
{:status-code 400, :errors errors})))
;; `:bulk/update` returns {:rows-updated <number-of-rows-updated>} on success.
(transduce
(map (comp first :rows-updated))
(completing +
(fn [num-rows-updated]
{:rows-updated num-rows-updated}))
0
successes))))})) | |
(ns metabase.driver.sql-jdbc.common (:require [clojure.string :as str] [metabase.util :as u])) | |
(def ^:private valid-separator-styles #{:url :comma :semicolon}) | |
(def ^:private ^:const default-name-value-separator "=") | |
(def ^:private separator-style->entry-separator {:comma ",", :semicolon ";", :url "&"}) | |
Adds | (defn conn-str-with-additional-opts
{:added "0.41.0", :arglists '([connection-string separator-style additional-opts])}
[connection-string separator-style additional-opts]
{:pre [(string? connection-string)
(or (nil? additional-opts) (string? additional-opts))
(contains? valid-separator-styles separator-style)]}
(str connection-string (when-not (str/blank? additional-opts)
(str (case separator-style
:comma ","
:semicolon ";"
:url (if (str/includes? connection-string "?")
"&"
"?"))
additional-opts)))) |
Turns a map of | (defn additional-opts->string
{:added "0.41.0"}
[separator-style additional-opts & [name-value-separator]]
{:pre [(or (nil? additional-opts) (map? additional-opts)) (contains? valid-separator-styles separator-style)]}
(when (some? additional-opts)
(reduce-kv (fn [m k v]
(str m
(when (seq m)
(separator-style->entry-separator separator-style))
(if (keyword? k)
(name k)
(str k))
(or name-value-separator default-name-value-separator)
v)) "" additional-opts))) |
If Optionally specify | (defn handle-additional-options
{:arglists '([connection-spec] [connection-spec details & {:keys [seperator-style]}])}
;; single arity provided for cases when `connection-spec` is built by applying simple transformations to `details`
([connection-spec]
(handle-additional-options connection-spec connection-spec))
;; two-arity+options version provided for when `connection-spec` is being built up separately from `details` source
([{connection-string :subname, :as connection-spec} {additional-options :additional-options, :as _details} & {:keys [seperator-style]
:or {seperator-style :url}}]
(-> (dissoc connection-spec :additional-options)
(assoc :subname (conn-str-with-additional-opts connection-string seperator-style additional-options))))) |
Attempts to parse the entires within the
| (defn additional-options->map
[additional-options separator-style & [name-value-separator? lowercase-keys?]]
{:pre [(or (nil? additional-options) (string? additional-options))
(contains? valid-separator-styles separator-style)
(or (nil? name-value-separator?) (and (string? name-value-separator?)
(= 1 (count name-value-separator?))))
(or (nil? lowercase-keys?) (boolean? lowercase-keys?))]}
(if (str/blank? additional-options)
{}
(let [entry-sep (separator-style->entry-separator separator-style)
nv-sep (or name-value-separator? default-name-value-separator)
pairs (str/split additional-options (re-pattern entry-sep))
k-fn (if (or (nil? lowercase-keys?) (true? lowercase-keys?)) u/lower-case-en identity)
kv-fn (fn [part]
(let [[k v] (str/split part (re-pattern (str "\\" nv-sep)))]
[(k-fn k) v]))
kvs (map kv-fn pairs)]
(into {} kvs)))) |
Logic for creating and managing connection pools for SQL JDBC drivers. Implementations for connection-related driver multimethods for SQL JDBC drivers. | (ns metabase.driver.sql-jdbc.connection
(:require
[clojure.java.jdbc :as jdbc]
[metabase.connection-pool :as connection-pool]
[metabase.db.connection :as mdb.connection]
[metabase.driver :as driver]
[metabase.lib.metadata :as lib.metadata]
[metabase.lib.metadata.jvm :as lib.metadata.jvm]
[metabase.models.interface :as mi]
[metabase.models.setting :as setting]
[metabase.query-processor.context.default :as context.default]
[metabase.query-processor.store :as qp.store]
[metabase.util :as u]
[metabase.util.i18n :refer [trs tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.ssh :as ssh]
#_{:clj-kondo/ignore [:discouraged-namespace]}
[toucan2.core :as t2])
(:import
(com.mchange.v2.c3p0 DataSources)
(javax.sql DataSource))) |
(set! *warn-on-reflection* true) | |
+----------------------------------------------------------------------------------------------------------------+ | Interface | +----------------------------------------------------------------------------------------------------------------+ | |
Given a Database DO NOT USE THIS METHOD DIRECTLY UNLESS YOU KNOW WHAT YOU ARE DOING! THIS RETURNS AN UNPOOLED CONNECTION SPEC! IF YOU WANT A CONNECTION SPEC FOR RUNNING QUERIES USE [[db->pooled-connection-spec]] INSTEAD WHICH WILL RETURN A POOLED CONNECTION SPEC. | (defmulti connection-details->spec
{:added "0.32.0" :arglists '([driver details-map])}
driver/dispatch-on-initialized-driver-safe-keys
:hierarchy #'driver/hierarchy) |
+----------------------------------------------------------------------------------------------------------------+ | Creating Connection Pools | +----------------------------------------------------------------------------------------------------------------+ | |
c3p0 connection pool properties for connected data warehouse DBs. See https://www.mchange.com/projects/c3p0/#configuration_properties for descriptions of properties. The c3p0 dox linked above do a good job of explaining the purpose of these properties and why you might set them. Generally, I have tried to choose configuration options for the data warehouse connection pools that minimize memory usage and maximize reliability, even when it comes with some added performance overhead. These pools are used for powering Cards and the sync process, which are less sensitive to overhead than something like the application DB. Drivers that need to override the default properties below can provide custom implementations of this method. | (defmulti data-warehouse-connection-pool-properties
{:added "0.33.4" :arglists '([driver database])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Name, from connection details, to use to identify a database in the c3p0 The default method uses the first non-nil value of the keys | (defmulti data-source-name
{:changelog-test/ignore true, :arglists '([driver details]), :added "0.45.0"}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(defmethod data-source-name :default
[_driver details]
((some-fn :db
:dbname
:sid
:service-name
:catalog)
details)) | |
Maximum size of the c3p0 connection pool. | (setting/defsetting jdbc-data-warehouse-max-connection-pool-size :visibility :internal :type :integer :default 15 :audit :getter) |
Kill connections if they are unreturned after this amount of time. In theory this should not be needed because the QP will kill connections that time out, but in practice it seems that connections disappear into the ether every once in a while; rather than exhaust the connection pool, let's be extra safe. This should be the same as the query timeout in [[metabase.query-processor.context.default/query-timeout-ms]] by default. | (setting/defsetting jdbc-data-warehouse-unreturned-connection-timeout-seconds
:visibility :internal
:type :integer
:getter (fn []
(or (setting/get-value-of-type :integer :jdbc-data-warehouse-unreturned-connection-timeout-seconds)
(long (/ context.default/query-timeout-ms 1000))))
:setter :none) |
(defmethod data-warehouse-connection-pool-properties :default
[driver database]
{ ;; only fetch one new connection at a time, rather than batching fetches (default = 3 at a time). This is done in
;; interest of minimizing memory consumption
"acquireIncrement" 1
;; [From dox] Seconds a Connection can remain pooled but unused before being discarded.
"maxIdleTime" (* 3 60 60) ; 3 hours
"minPoolSize" 1
"initialPoolSize" 1
"maxPoolSize" (jdbc-data-warehouse-max-connection-pool-size)
;; [From dox] If true, an operation will be performed at every connection checkout to verify that the connection is
;; valid. [...] ;; Testing Connections in checkout is the simplest and most reliable form of Connection testing,
;; but for better performance, consider verifying connections periodically using `idleConnectionTestPeriod`. [...]
;; If clients usually make complex queries and/or perform multiple operations, adding the extra cost of one fast
;; test per checkout will not much affect performance.
;;
;; As noted in the C3P0 dox, this does add some overhead, but since all of our drivers are JDBC 4 drivers, they can
;; call `Connection.isValid()`, which is reasonably efficient. In my profiling enabling this adds ~100µs for
;; Postgres databases on the same machince and ~70ms for remote databases on AWS east testing against a local
;; server on the West Coast.
;;
;; This suggests the additional cost of this test is more or less based entirely to the network latency of the
;; request. IRL the Metabase server and data warehouse are likely to be located in closer geographical proximity to
;; one another than my trans-contintental tests. Thus in the majority of cases the overhead should be next to
;; nothing, and in the worst case close to imperceptible.
"testConnectionOnCheckout" true
;; [From dox] Number of seconds that Connections in excess of minPoolSize should be permitted to remain idle in the
;; pool before being culled. Intended for applications that wish to aggressively minimize the number of open
;; Connections, shrinking the pool back towards minPoolSize if, following a spike, the load level diminishes and
;; Connections acquired are no longer needed. If maxIdleTime is set, maxIdleTimeExcessConnections should be smaller
;; if the parameter is to have any effect.
;;
;; Kill idle connections above the minPoolSize after 5 minutes.
"maxIdleTimeExcessConnections" (* 5 60)
;; kill connections after this amount of time if they haven't been returned -- this should be the same as the query
;; timeout. This theoretically shouldn't happen since the QP should kill things after a certain timeout but it's
;; better to be safe than sorry -- it seems like in practice some connections disappear into the ether
"unreturnedConnectionTimeout" (jdbc-data-warehouse-unreturned-connection-timeout-seconds)
;; Set the data source name so that the c3p0 JMX bean has a useful identifier, which incorporates the DB ID, driver,
;; and name from the details
"dataSourceName" (format "db-%d-%s-%s"
(u/the-id database)
(name driver)
(data-source-name driver (:details database)))}) | |
Like [[connection-pool/connection-pool-spec]] but also handles situations when the unpooled spec is a | (defn- connection-pool-spec
[{:keys [^DataSource datasource], :as spec} pool-properties]
(if datasource
{:datasource (DataSources/pooledDataSource datasource (connection-pool/map->properties pool-properties))}
(connection-pool/connection-pool-spec spec pool-properties))) |
(defn ^:private default-ssh-tunnel-target-port [driver]
(when-let [port-info (some
#(when (= "port" (:name %)) %)
(driver/connection-properties driver))]
(or (:default port-info)
(:placeholder port-info)))) | |
Create a new C3P0 | (defn- create-pool!
[{:keys [id details], driver :engine, :as database}]
{:pre [(map? database)]}
(log/debug (u/format-color 'cyan (trs "Creating new connection pool for {0} database {1} ..." driver id)))
(let [details-with-tunnel (driver/incorporate-ssh-tunnel-details ;; If the tunnel is disabled this returned unchanged
driver
(update details :port #(or % (default-ssh-tunnel-target-port driver))))
spec (connection-details->spec driver details-with-tunnel)
properties (data-warehouse-connection-pool-properties driver database)]
(merge
(connection-pool-spec spec properties)
;; also capture entries related to ssh tunneling for later use
(select-keys spec [:tunnel-enabled :tunnel-session :tunnel-tracker :tunnel-entrance-port :tunnel-entrance-host])))) |
(defn- destroy-pool! [database-id pool-spec]
(log/debug (u/format-color 'red (trs "Closing old connection pool for database {0} ..." database-id)))
(connection-pool/destroy-connection-pool! pool-spec)
(ssh/close-tunnel! pool-spec)) | |
A map of our currently open connection pools, keyed by Database | (defonce ^:private
database-id->connection-pool
(atom {})) |
A map of DB details hash values, keyed by Database | (defonce ^:private
database-id->jdbc-spec-hash
(atom {})) |
Computes a hash value for the JDBC connection spec based on | (mu/defn ^:private jdbc-spec-hash
[{driver :engine, :keys [details], :as database} :- [:maybe :map]]
(when (some? database)
(hash (connection-details->spec driver details)))) |
Atomically update the current connection pool for Database | (defn- set-pool!
[database-id pool-spec-or-nil database]
{:pre [(integer? database-id)]}
(let [[old-id->pool] (if pool-spec-or-nil
(swap-vals! database-id->connection-pool assoc database-id pool-spec-or-nil)
(swap-vals! database-id->connection-pool dissoc database-id))]
;; if we replaced a different pool with the new pool that is different from the old one, destroy the old pool
(when-let [old-pool-spec (get old-id->pool database-id)]
(when-not (identical? old-pool-spec pool-spec-or-nil)
(destroy-pool! database-id old-pool-spec))))
;; update the db details hash cache with the new hash value
(swap! database-id->jdbc-spec-hash assoc database-id (jdbc-spec-hash database))
nil) |
Invalidates the connection pool for the given database by closing it and removing it from the cache. | (defn invalidate-pool-for-db! [database] (set-pool! (u/the-id database) nil nil)) |
(defn- log-ssh-tunnel-reconnect-msg! [db-id]
(log/warn (u/format-color 'red (trs "ssh tunnel for database {0} looks closed; marking pool invalid to reopen it"
db-id)))
nil) | |
(defn- log-jdbc-spec-hash-change-msg! [db-id]
(log/warn (u/format-color 'yellow (trs "Hash of database {0} details changed; marking pool invalid to reopen it"
db-id)))
nil) | |
Return a JDBC connection spec that includes a cp30 | (defn db->pooled-connection-spec
[db-or-id-or-spec]
(cond
;; db-or-id-or-spec is a Database instance or an integer ID
(u/id db-or-id-or-spec)
(let [database-id (u/the-id db-or-id-or-spec)
;; we need the Database instance no matter what (in order to compare details hash with cached value)
db (or (when (mi/instance-of? :model/Database db-or-id-or-spec)
(lib.metadata.jvm/instance->metadata db-or-id-or-spec :metadata/database))
(when (= (:lib/type db-or-id-or-spec) :metadata/database)
db-or-id-or-spec)
(qp.store/with-metadata-provider database-id
(lib.metadata/database (qp.store/metadata-provider))))
get-fn (fn [db-id log-invalidation?]
(let [details (get @database-id->connection-pool db-id ::not-found)]
(cond
;; for the audit db, we pass the datasource for the app-db. This lets us use fewer db
;; connections with *application-db* and 1 less connection pool. Note: This data-source is
;; not in [[database-id->connection-pool]].
(:is-audit db)
{:datasource (mdb.connection/data-source)}
(= ::not-found details)
nil
;; details hash changed from what is cached; invalid
(let [curr-hash (get @database-id->jdbc-spec-hash db-id)
new-hash (jdbc-spec-hash db)]
(when (and (some? curr-hash) (not= curr-hash new-hash))
;; the hash didn't match, but it's possible that a stale instance of `DatabaseInstance`
;; was passed in (ex: from a long-running sync operation); fetch the latest one from
;; our app DB, and see if it STILL doesn't match
(not= curr-hash (-> (t2/select-one [:model/Database :id :engine :details] :id database-id)
jdbc-spec-hash))))
(when log-invalidation?
(log-jdbc-spec-hash-change-msg! db-id))
(nil? (:tunnel-session details)) ; no tunnel in use; valid
details
(ssh/ssh-tunnel-open? details) ; tunnel in use, and open; valid
details
:else ; tunnel in use, and not open; invalid
(when log-invalidation?
(log-ssh-tunnel-reconnect-msg! db-id)))))]
(or
;; we have an existing pool for this database, so use it
(get-fn database-id true)
;; Even tho `set-pool!` will properly shut down old pools if two threads call this method at the same time, we
;; don't want to end up with a bunch of simultaneous threads creating pools only to have them destroyed the
;; very next instant. This will cause their queries to fail. Thus we should do the usual locking here and make
;; sure only one thread will be creating a pool at a given instant.
(locking database-id->connection-pool
(or
;; check if another thread created the pool while we were waiting to acquire the lock
(get-fn database-id false)
;; create a new pool and add it to our cache, then return it
(u/prog1 (create-pool! db)
(set-pool! database-id <> db))))))
;; already a `clojure.java.jdbc` spec map
(map? db-or-id-or-spec)
db-or-id-or-spec
;; invalid. Throw Exception
:else
(throw (ex-info (tru "Not a valid Database/Database ID/JDBC spec")
;; don't log the actual spec lest we accidentally expose credentials
{:input (class db-or-id-or-spec)})))) |
+----------------------------------------------------------------------------------------------------------------+ | metabase.driver impls | +----------------------------------------------------------------------------------------------------------------+ | |
Impl for [[with-connection-spec-for-testing-connection]]. | (defn do-with-connection-spec-for-testing-connection
[driver details f]
(let [details (update details :port #(or % (default-ssh-tunnel-target-port driver)))]
(ssh/with-ssh-tunnel [details-with-tunnel details]
(let [spec (connection-details->spec driver details-with-tunnel)]
(f spec))))) |
Execute (with-connection-spec-for-testing-connection [jdbc-spec [:my-driver conn-details]] (do-something-with-spec jdbc-spec) | (defmacro with-connection-spec-for-testing-connection
{:added "0.45.0", :style/indent 1}
[[jdbc-spec-binding [driver details]] & body]
`(do-with-connection-spec-for-testing-connection ~driver ~details (^:once fn* [~jdbc-spec-binding] ~@body))) |
Can we connect to a JDBC database with [[clojure.java.jdbc]] | (defn can-connect-with-spec?
[jdbc-spec]
(let [[first-row] (jdbc/query jdbc-spec ["SELECT 1"])
[result] (vals first-row)]
(= result 1))) |
Default implementation of [[driver/can-connect?]] for SQL JDBC drivers. Checks whether we can perform a simple
| (defn can-connect?
[driver details]
(with-connection-spec-for-testing-connection [jdbc-spec [driver details]]
(can-connect-with-spec? jdbc-spec))) |
Code related to actually running a SQL query against a JDBC database and for properly encoding/decoding types going
in and out of the database. Old, non-reducible implementation can be found in
| (ns metabase.driver.sql-jdbc.execute
(:require
[clojure.core.async :as a]
[clojure.java.jdbc :as jdbc]
[clojure.string :as str]
[java-time.api :as t]
[metabase.driver :as driver]
[metabase.driver.sql-jdbc.connection :as sql-jdbc.conn]
[metabase.driver.sql-jdbc.execute.diagnostic
:as sql-jdbc.execute.diagnostic]
[metabase.driver.sql-jdbc.execute.old-impl :as sql-jdbc.execute.old]
[metabase.driver.sql-jdbc.sync.interface :as sql-jdbc.sync.interface]
[metabase.lib.metadata :as lib.metadata]
[metabase.lib.schema.expression.temporal
:as lib.schema.expression.temporal]
[metabase.lib.schema.literal.jvm :as lib.schema.literal.jvm]
[metabase.models.setting :refer [defsetting]]
[metabase.public-settings.premium-features :refer [defenterprise]]
[metabase.query-processor.context :as qp.context]
[metabase.query-processor.error-type :as qp.error-type]
[metabase.query-processor.middleware.limit :as limit]
[metabase.query-processor.reducible :as qp.reducible]
[metabase.query-processor.store :as qp.store]
[metabase.query-processor.timezone :as qp.timezone]
[metabase.query-processor.util :as qp.util]
[metabase.util :as u]
[metabase.util.i18n :refer [trs tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[potemkin :as p])
(:import
(java.sql Connection JDBCType PreparedStatement ResultSet ResultSetMetaData Statement Types)
(java.time Instant LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime ZonedDateTime)
(javax.sql DataSource))) |
(set! *warn-on-reflection* true) | |
+----------------------------------------------------------------------------------------------------------------+ | SQL JDBC Reducible QP Interface | +----------------------------------------------------------------------------------------------------------------+ | |
Malli schema for the options passed to [[do-with-connection-with-options]]. | (def ConnectionOptions
[:maybe
[:map
;; a string like 'US/Pacific' or something like that.
[:session-timezone {:optional true} [:maybe [:ref ::lib.schema.expression.temporal/timezone-id]]]
;; whether this Connection should NOT be read-only, e.g. for DDL stuff or inserting data or whatever.
[:write? {:optional true} [:maybe :boolean]]]]) |
Fetch a [[java.sql.Connection]] from a (f connection) If If
The normal 'happy path' is more or less (with-open [conn (.getConnection (datasource driver db-or-id-or-spec))] (set-best-transaction-level! driver conn) (set-time-zone-if-supported! driver conn session-timezone) (.setReadOnly conn true) (.setAutoCommit conn true) ; so the query(s) are not ran inside a transaction (.setHoldability conn ResultSet/CLOSECURSORSAT_COMMIT) (f conn)) This default implementation is abstracted out into two functions, [[do-with-resolved-connection]] and [[set-default-connection-options!]], that you can use as needed in custom implementations. See various driver implementations for examples. You should only set connection options on top-level calls to [[do-with-connection-with-options]]; check whether this is a [[recursive-connection?]] before setting options. There are two usual ways to set the session timezone if your driver supports them:
| (defmulti do-with-connection-with-options
{:added "0.47.0"
:arglists '([driver db-or-id-or-spec options f])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Set the | (defmulti set-parameter
{:added "0.34.0" :arglists '([driver prepared-statement i object])}
(fn [driver _ _ object]
[(driver/dispatch-on-initialized-driver driver) (class object)])
:hierarchy #'driver/hierarchy) |
TODO -- maybe like [[do-with-connection-with-options]] we should replace [[prepared-statment]] and [[statement]]
with | |
Create a PreparedStatement with | (defmulti ^PreparedStatement prepared-statement
{:added "0.35.0",
:arglists '(^java.sql.PreparedStatement [driver ^java.sql.Connection connection ^String sql params])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Indicates whether the given driver supports creating a java.sql.Statement, via the Connection. By default, this is true for all :sql-jdbc drivers. If the underlying driver does not support Statement creation, override this as false. | (defmulti ^Statement statement-supported?
{:added "0.39.0", :arglists '([driver])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Create a Statement object using the given connection. Only called if statement-supported? above returns true. This
is to be used to execute native queries, which implies there are no parameters. As with prepared-statement, you
shouldn't need to override the default implementation for this method; if you do, take care to set options to maximize
result set read performance (e.g. | (defmulti ^Statement statement
{:added "0.39.0", :arglists '(^java.sql.Statement [driver ^java.sql.Connection connection])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Execute a | (defmulti execute-prepared-statement!
{:added "0.39.0", :arglists '(^java.sql.ResultSet [driver ^java.sql.PreparedStatement stmt])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Runs a SQL select query with a given | (defmulti execute-statement!
{:added "0.39.0", :arglists '(^java.sql.ResultSet [driver ^java.sql.Statement stmt ^String sql])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Return a sequence of maps containing information about the corresponding columns in query results. The default implementation fetches this information via the result set metadata. It is unlikely you will need to override this. | (defmulti column-metadata
{:added "0.35.0", :arglists '([driver ^java.sql.ResultSetMetaData rsmeta])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Return a zero-arg function that, when called, will fetch the value of the column from the current row. This also supports defaults for the entire driver: ;; default method for Postgres not covered by any [driver jdbc-type] methods (defmethod read-column-thunk :postgres ...) | (defmulti read-column-thunk
{:added "0.35.0", :arglists '([driver ^java.sql.ResultSet rs ^java.sql.ResultSetMetaData rsmeta i])}
(fn [driver _rs ^ResultSetMetaData rsmeta ^Long col-idx]
[(driver/dispatch-on-initialized-driver driver) (.getColumnType rsmeta col-idx)])
:hierarchy #'driver/hierarchy) |
+----------------------------------------------------------------------------------------------------------------+ | Default Impl | +----------------------------------------------------------------------------------------------------------------+ | |
Fetch the connection pool | (defn datasource
{:added "0.35.0"}
^DataSource [db-or-id-or-spec]
(:datasource (sql-jdbc.conn/db->pooled-connection-spec db-or-id-or-spec))) |
Fetch the connection pool | (defn datasource-with-diagnostic-info!
{:added "0.40.0"}
^DataSource [driver db-or-id]
(let [ds (datasource db-or-id)]
(sql-jdbc.execute.diagnostic/record-diagnostic-info-for-pool! driver (u/the-id db-or-id) ds)
ds)) |
Execute | (defn set-time-zone-if-supported!
{:deprecated "0.35.0"}
[driver ^Connection conn ^String timezone-id]
(when timezone-id
(when-let [format-string (sql-jdbc.execute.old/set-timezone-sql driver)]
(try
(let [sql (format format-string (str \' timezone-id \'))]
(log/debug (trs "Setting {0} database timezone with statement: {1}" driver (pr-str sql)))
(try
(.setReadOnly conn false)
(catch Throwable e
(log/debug e (trs "Error setting connection to readwrite"))))
(with-open [stmt (.createStatement conn)]
(.execute stmt sql)
(log/tracef "Successfully set timezone for %s database to %s" driver timezone-id)))
(catch Throwable e
(log/error e (trs "Failed to set timezone ''{0}'' for {1} database" timezone-id driver))))))) |
OSS no-op implementation of | (defenterprise set-role-if-supported! metabase-enterprise.advanced-permissions.driver.impersonation [_ _ _]) |
Set the connection transaction isolation level to the least-locking level supported by the DB. See https://docs.oracle.com/cd/E19830-01/819-4721/beamv/index.html for an explanation of these levels. TODO - since we're not running the queries in a transaction, does this make any difference at all? | (defn set-best-transaction-level!
{:added "0.35.0"}
[driver ^Connection conn]
(let [dbmeta (.getMetaData conn)]
(loop [[[level-name ^Integer level] & more] [[:read-uncommitted Connection/TRANSACTION_READ_UNCOMMITTED]
[:repeatable-read Connection/TRANSACTION_REPEATABLE_READ]
[:read-committed Connection/TRANSACTION_READ_COMMITTED]]]
(cond
(.supportsTransactionIsolationLevel dbmeta level)
(do
(log/tracef "Set transaction isolation level for %s database to %s" (name driver) level-name)
(try
(.setTransactionIsolation conn level)
(catch Throwable e
(log/debug e (trs "Error setting transaction isolation level for {0} database to {1}" (name driver) level-name)))))
(seq more)
(recur more))))) |
(mu/defn do-with-resolved-connection-data-source :- (lib.schema.literal.jvm/instance-of DataSource)
"Part of the default implementation for [[do-with-connection-with-options]]: get an appropriate `java.sql.DataSource`
for `db-or-id-or-spec`. Not for use with a JDBC spec wrapping a `java.sql.Connection` (a spec with the key
`:connection`), since we do not have control over its lifecycle and would thus not be able to use [[with-open]] with
Connections provided by this DataSource."
{:added "0.47.0", :arglists '(^javax.sql.DataSource [driver db-or-id-or-spec options])}
[driver :- :keyword
db-or-id-or-spec :- [:and
[:or :int :map]
[:fn
;; can't wrap a java.sql.Connection here because we're not
;; responsible for its lifecycle and that means you can't use
;; `with-open` on the Connection you'd get from the DataSource
{:error/message "Cannot be a JDBC spec wrapping a java.sql.Connection"}
(complement :connection)]]
{:keys [^String session-timezone], :as _options} :- ConnectionOptions]
(if-not (u/id db-or-id-or-spec)
;; not a Database or Database ID... this is a raw `clojure.java.jdbc` spec, use that
;; directly.
(reify DataSource
(getConnection [_this]
#_{:clj-kondo/ignore [:discouraged-var]}
(jdbc/get-connection db-or-id-or-spec)))
;; otherwise this is either a Database or Database ID.
(if-let [old-method-impl (get-method
#_{:clj-kondo/ignore [:deprecated-var]} sql-jdbc.execute.old/connection-with-timezone
driver)]
;; use the deprecated impl for `connection-with-timezone` if one exists.
(do
(log/warn (trs "{0} is deprecated in Metabase 0.47.0. Implement {1} instead."
#_{:clj-kondo/ignore [:deprecated-var]}
`connection-with-timezone
`do-with-connection-with-options))
;; for compatibility, make sure we pass it an actual Database instance.
(let [database (if (integer? db-or-id-or-spec)
(qp.store/with-metadata-provider db-or-id-or-spec
(lib.metadata/database (qp.store/metadata-provider)))
db-or-id-or-spec)]
(reify DataSource
(getConnection [_this]
(old-method-impl driver database session-timezone)))))
(datasource-with-diagnostic-info! driver db-or-id-or-spec)))) | |
In recursive calls to [[do-with-connection-with-options]] we don't want to set options AGAIN, because this might
break things. For example in a top-level This gets incremented inside [[do-with-resolved-connection]], so the top level call with have a depth of | (def ^:private ^:dynamic ^{:added "0.47.0"} *connection-recursion-depth*
-1) |
Whether or not we are in a recursive call to [[do-with-connection-with-options]]. If we are, you shouldn't set Connection options AGAIN, as that may override previous options that we don't want to override. | (defn recursive-connection?
[]
{:added "0.47.0"}
(pos? *connection-recursion-depth*)) |
Execute (f ^java.sql.Connection conn) with a resolved JDBC connection. Part of the default implementation for [[do-with-connection-with-options]].
Generally does not set any | (mu/defn do-with-resolved-connection
{:added "0.47.0"}
[driver :- :keyword
db-or-id-or-spec :- [:or :int :map]
options :- ConnectionOptions
f :- fn?]
(binding [*connection-recursion-depth* (inc *connection-recursion-depth*)]
(if-let [conn (:connection db-or-id-or-spec)]
(f conn)
(with-open [conn (.getConnection (do-with-resolved-connection-data-source driver db-or-id-or-spec options))]
(f conn))))) |
Part of the default implementation of [[do-with-connection-with-options]]: set options for a newly fetched Connection. | (mu/defn set-default-connection-options!
{:added "0.47.0"}
[driver :- :keyword
db-or-id-or-spec
^Connection conn :- (lib.schema.literal.jvm/instance-of Connection)
{:keys [^String session-timezone write?], :as options} :- ConnectionOptions]
(when-not (recursive-connection?)
(log/tracef "Setting default connection options with options %s" (pr-str options))
(set-best-transaction-level! driver conn)
(set-time-zone-if-supported! driver conn session-timezone)
(set-role-if-supported! driver conn (cond (integer? db-or-id-or-spec) (qp.store/with-metadata-provider db-or-id-or-spec
(lib.metadata/database (qp.store/metadata-provider)))
(u/id db-or-id-or-spec) db-or-id-or-spec))
(let [read-only? (not write?)]
(try
;; Setting the connection to read-only does not prevent writes on some databases, and is meant
;; to be a hint to the driver to enable database optimizations
;; See https://docs.oracle.com/javase/8/docs/api/java/sql/Connection.html#setReadOnly-boolean-
(log/trace (pr-str (list '.setReadOnly 'conn read-only?)))
(.setReadOnly conn read-only?)
(catch Throwable e
(log/debugf e "Error setting connection readOnly to %s" (pr-str read-only?)))))
;; If this is (supposedly) a read-only connection, we would prefer enable auto-commit
;; so this IS NOT ran inside of a transaction, but without transaction the read-only
;; flag has no effect for most of the drivers.
;; TODO Enable auto-commit after having communicated this change in behvaior to our users.
;;
;; TODO -- for `write?` connections, we should probably disable autoCommit and then manually call `.commit` at after
;; `f`... we need to check and make sure that won't mess anything up, since some existing code is already doing it
;; manually.
(when-not write?
(try
(log/trace (pr-str '(.setAutoCommit conn true)))
(.setAutoCommit conn true)
(catch Throwable e
(log/debug e "Error enabling connection autoCommit"))))
(try
(log/trace (pr-str '(.setHoldability conn ResultSet/CLOSE_CURSORS_AT_COMMIT)))
(.setHoldability conn ResultSet/CLOSE_CURSORS_AT_COMMIT)
(catch Throwable e
(log/debug e (trs "Error setting default holdability for connection")))))) |
(defmethod do-with-connection-with-options :sql-jdbc
[driver db-or-id-or-spec options f]
(do-with-resolved-connection
driver
db-or-id-or-spec
options
(fn [^Connection conn]
(set-default-connection-options! driver db-or-id-or-spec conn options)
(f conn)))) | |
TODO - would a more general method to convert a parameter to the desired class (and maybe JDBC type) be more useful? Then we can actually do things like log what transformations are taking place | |
(defn- set-object
([^PreparedStatement prepared-statement, ^Integer index, object]
(log/tracef "(set-object prepared-statement %d ^%s %s)" index (some-> object class .getName) (pr-str object))
(.setObject prepared-statement index object))
([^PreparedStatement prepared-statement, ^Integer index, object, ^Integer target-sql-type]
(log/tracef "(set-object prepared-statement %d ^%s %s java.sql.Types/%s)" index (some-> object class .getName)
(pr-str object) (.getName (JDBCType/valueOf target-sql-type)))
(.setObject prepared-statement index object target-sql-type))) | |
(defmethod set-parameter :default [_ prepared-statement i object] (set-object prepared-statement i object)) | |
(defmethod set-parameter [::driver/driver LocalDate] [_ prepared-statement i t] (set-object prepared-statement i t Types/DATE)) | |
(defmethod set-parameter [::driver/driver LocalTime] [_ prepared-statement i t] (set-object prepared-statement i t Types/TIME)) | |
(defmethod set-parameter [::driver/driver LocalDateTime] [_ prepared-statement i t] (set-object prepared-statement i t Types/TIMESTAMP)) | |
(defmethod set-parameter [::driver/driver OffsetTime] [_ prepared-statement i t] (set-object prepared-statement i t Types/TIME_WITH_TIMEZONE)) | |
(defmethod set-parameter [::driver/driver OffsetDateTime] [_ prepared-statement i t] (set-object prepared-statement i t Types/TIMESTAMP_WITH_TIMEZONE)) | |
(defmethod set-parameter [::driver/driver ZonedDateTime] [_ prepared-statement i t] (set-object prepared-statement i t Types/TIMESTAMP_WITH_TIMEZONE)) | |
(defmethod set-parameter [::driver/driver Instant] [driver prepared-statement i t] (set-parameter driver prepared-statement i (t/offset-date-time t (t/zone-offset 0)))) | |
TODO - this might not be needed for all drivers. It is at least needed for H2 and Postgres. Not sure which, if any
JDBC drivers support | (defmethod set-parameter [::driver/driver ZonedDateTime] [driver prepared-statement i t] (set-parameter driver prepared-statement i (t/offset-date-time t))) |
Set parameters for the prepared statement by calling | (defn set-parameters!
{:added "0.35.0"}
[driver stmt params]
(when (< (try (.. ^PreparedStatement stmt getParameterMetaData getParameterCount)
(catch Throwable _ (count params)))
(count params))
(throw (ex-info (tru "It looks like we got more parameters than we can handle, remember that parameters cannot be used in comments or as identifiers.")
{:driver driver
:type qp.error-type/driver
:statement (str/split-lines (str stmt))
:params params})))
(dorun
(map-indexed
(fn [i param]
(log/tracef "Set param %d -> %s" (inc i) (pr-str param))
(set-parameter driver stmt (inc i) param))
params))) |
Fetch size for result sets. We want to ensure that the jdbc ResultSet objects are not realizing the entire results in memory. | (defsetting sql-jdbc-fetch-size :default 500 :type :integer :visibility :internal) |
(defmethod prepared-statement :sql-jdbc
[driver ^Connection conn ^String sql params]
(let [stmt (.prepareStatement conn
sql
ResultSet/TYPE_FORWARD_ONLY
ResultSet/CONCUR_READ_ONLY
ResultSet/CLOSE_CURSORS_AT_COMMIT)]
(try
(try
(.setFetchDirection stmt ResultSet/FETCH_FORWARD)
(catch Throwable e
(log/debug e (trs "Error setting prepared statement fetch direction to FETCH_FORWARD"))))
(try
(when (zero? (.getFetchSize stmt))
(.setFetchSize stmt (sql-jdbc-fetch-size)))
(catch Throwable e
(log/debug e (trs "Error setting prepared statement fetch size to fetch-size"))))
(set-parameters! driver stmt params)
stmt
(catch Throwable e
(.close stmt)
(throw e))))) | |
by default, drivers support .createStatement | (defmethod statement-supported? :sql-jdbc [_] true) |
(defmethod statement :sql-jdbc
[_ ^Connection conn]
(let [stmt (.createStatement conn
ResultSet/TYPE_FORWARD_ONLY
ResultSet/CONCUR_READ_ONLY
ResultSet/CLOSE_CURSORS_AT_COMMIT)]
(try
(try
(.setFetchDirection stmt ResultSet/FETCH_FORWARD)
(catch Throwable e
(log/debug e (trs "Error setting statement fetch direction to FETCH_FORWARD"))))
(try
(when (zero? (.getFetchSize stmt))
(.setFetchSize stmt (sql-jdbc-fetch-size)))
(catch Throwable e
(log/debug e (trs "Error setting statement fetch size to fetch-size"))))
stmt
(catch Throwable e
(.close stmt)
(throw e))))) | |
If | (defn- wire-up-canceled-chan-to-cancel-Statement!
[^Statement stmt canceled-chan]
(when canceled-chan
(a/go
(when (a/<! canceled-chan)
(log/debug (trs "Query canceled, calling Statement.cancel()"))
(u/ignore-exceptions
(.cancel stmt)))))) |
(defn- prepared-statement*
^PreparedStatement [driver conn sql params canceled-chan]
;; sometimes preparing the statement fails, usually if the SQL syntax is invalid.
(doto (try
(prepared-statement driver conn sql params)
(catch Throwable e
(throw (ex-info (tru "Error preparing statement: {0}" (ex-message e))
{:driver driver
:type qp.error-type/driver
:sql (str/split-lines (driver/prettify-native-form driver sql))
:params params}
e))))
(wire-up-canceled-chan-to-cancel-Statement! canceled-chan))) | |
(defn- use-statement? [driver params] (and (statement-supported? driver) (empty? params))) | |
(defn- statement* ^Statement [driver conn canceled-chan]
(doto (statement driver conn)
(wire-up-canceled-chan-to-cancel-Statement! canceled-chan))) | |
Create a statement or a prepared statement. Should be called from [[with-open]]. | (defn statement-or-prepared-statement
^Statement [driver conn sql params canceled-chan]
(if (use-statement? driver params)
(statement* driver conn canceled-chan)
(prepared-statement* driver conn sql params canceled-chan))) |
(defmethod execute-prepared-statement! :sql-jdbc [_ ^PreparedStatement stmt] (.executeQuery stmt)) | |
(defmethod execute-statement! :sql-jdbc
[driver ^Statement stmt ^String sql]
(if (.execute stmt sql)
(.getResultSet stmt)
(throw (ex-info (str (tru "Select statement did not produce a ResultSet for native query"))
{:sql sql :driver driver})))) | |
(defn- execute-statement-or-prepared-statement! ^ResultSet [driver ^Statement stmt max-rows params sql]
(let [st (doto stmt (.setMaxRows max-rows))]
(if (use-statement? driver params)
(execute-statement! driver st sql)
(execute-prepared-statement! driver st)))) | |
(defmethod read-column-thunk :default
[driver ^ResultSet rs rsmeta ^long i]
(let [driver-default-method (get-method read-column-thunk driver)]
(if-not (= driver-default-method (get-method read-column-thunk :default))
^{:name (format "(read-column-thunk %s)" driver)} (driver-default-method driver rs rsmeta i)
^{:name (format "(.getObject rs %d)" i)} (fn []
(.getObject rs i))))) | |
(defn- get-object-of-class-thunk [^ResultSet rs, ^long i, ^Class klass]
^{:name (format "(.getObject rs %d %s)" i (.getCanonicalName klass))}
(fn []
(.getObject rs i klass))) | |
(defmethod read-column-thunk [:sql-jdbc Types/TIMESTAMP] [_ rs _ i] (get-object-of-class-thunk rs i java.time.LocalDateTime)) | |
(defmethod read-column-thunk [:sql-jdbc Types/TIMESTAMP_WITH_TIMEZONE] [_ rs _ i] (get-object-of-class-thunk rs i java.time.OffsetDateTime)) | |
(defmethod read-column-thunk [:sql-jdbc Types/DATE] [_ rs _ i] (get-object-of-class-thunk rs i java.time.LocalDate)) | |
(defmethod read-column-thunk [:sql-jdbc Types/TIME] [_ rs _ i] (get-object-of-class-thunk rs i java.time.LocalTime)) | |
(defmethod read-column-thunk [:sql-jdbc Types/TIME_WITH_TIMEZONE] [_ rs _ i] (get-object-of-class-thunk rs i java.time.OffsetTime)) | |
(defn- column-range [^ResultSetMetaData rsmeta] (range 1 (inc (.getColumnCount rsmeta)))) | |
(defn- log-readers [driver ^ResultSetMetaData rsmeta fns]
(log/trace
(str/join
"\n"
(for [^Integer i (column-range rsmeta)]
(format "Reading %s column %d %s (JDBC type: %s, DB type: %s) with %s"
driver
i
(pr-str (.getColumnName rsmeta i))
(or (u/ignore-exceptions
(.getName (JDBCType/valueOf (.getColumnType rsmeta i))))
(.getColumnType rsmeta i))
(.getColumnTypeName rsmeta i)
(let [f (nth fns (dec i))]
(or (:name (meta f))
f))))))) | |
Returns a thunk that can be called repeatedly to get the next row in the result set, using appropriate methods to
fetch each value in the row. Returns | (defn row-thunk
[driver ^ResultSet rs ^ResultSetMetaData rsmeta]
(let [fns (for [i (column-range rsmeta)]
(read-column-thunk driver rs rsmeta (long i)))]
(log-readers driver rsmeta fns)
(let [thunk (if (seq fns)
(apply juxt fns)
(constantly []))]
(fn row-thunk* []
(when (.next rs)
(thunk)))))) |
(defmethod column-metadata :sql-jdbc
[driver ^ResultSetMetaData rsmeta]
(mapv
(fn [^Integer i]
(let [col-name (.getColumnLabel rsmeta i)
db-type-name (.getColumnTypeName rsmeta i)
base-type (sql-jdbc.sync.interface/database-type->base-type driver (keyword db-type-name))]
(log/tracef "Column %d '%s' is a %s which is mapped to base type %s for driver %s\n"
i col-name db-type-name base-type driver)
{:name col-name
;; TODO - disabled for now since it breaks a lot of tests. We can re-enable it when the tests are in a better
;; state
#_:original_name #_(.getColumnName rsmeta i)
#_:jdbc_type #_ (u/ignore-exceptions
(.getName (JDBCType/valueOf (.getColumnType rsmeta i))))
#_:db_type #_db-type-name
:base_type (or base-type :type/*)}))
(column-range rsmeta))) | |
Returns an object that can be reduced to fetch the rows and columns in a | (defn reducible-rows
{:added "0.35.0"}
[driver ^ResultSet rs ^ResultSetMetaData rsmeta canceled-chan]
(let [row-thunk (row-thunk driver rs rsmeta)]
(qp.reducible/reducible-rows row-thunk canceled-chan))) |
Injects the remark into the SQL query text. | (defmulti inject-remark
{:added "0.48.0", :arglists '([driver sql remark])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(defmethod inject-remark :default [_ sql remark] (str "-- " remark "\n" sql)) | |
Default impl of | (defn execute-reducible-query
{:added "0.35.0", :arglists '([driver query context respond] [driver sql params max-rows context respond])}
([driver {{sql :query, params :params} :native, :as outer-query} context respond]
{:pre [(string? sql) (seq sql)]}
(let [database (lib.metadata/database (qp.store/metadata-provider))
sql (if (get-in database [:details :include-user-id-and-hash] true)
(->> (qp.util/query->remark driver outer-query)
(inject-remark driver sql))
sql)
max-rows (limit/determine-query-max-rows outer-query)]
(execute-reducible-query driver sql params max-rows context respond)))
([driver sql params max-rows context respond]
(do-with-connection-with-options
driver
(lib.metadata/database (qp.store/metadata-provider))
{:session-timezone (qp.timezone/report-timezone-id-if-supported driver (lib.metadata/database (qp.store/metadata-provider)))}
(fn [^Connection conn]
(with-open [stmt (statement-or-prepared-statement driver conn sql params (qp.context/canceled-chan context))
^ResultSet rs (try
(execute-statement-or-prepared-statement! driver stmt max-rows params sql)
(catch Throwable e
(throw (ex-info (tru "Error executing query: {0}" (ex-message e))
{:driver driver
:sql (str/split-lines (driver/prettify-native-form driver sql))
:params params
:type qp.error-type/invalid-query}
e))))]
(let [rsmeta (.getMetaData rs)
results-metadata {:cols (column-metadata driver rsmeta)}]
(respond results-metadata (reducible-rows driver rs rsmeta (qp.context/canceled-chan context))))))))) |
+----------------------------------------------------------------------------------------------------------------+ | Actions Stuff | +----------------------------------------------------------------------------------------------------------------+ | |
(defmethod driver/execute-write-query! :sql-jdbc
[driver {{sql :query, :keys [params]} :native}]
{:pre [(string? sql)]}
(try
(do-with-connection-with-options
driver
(lib.metadata/database (qp.store/metadata-provider))
{:write? true
:session-timezone (qp.timezone/report-timezone-id-if-supported driver (lib.metadata/database (qp.store/metadata-provider)))}
(fn [^Connection conn]
(with-open [stmt (statement-or-prepared-statement driver conn sql params nil)]
{:rows-affected (if (instance? PreparedStatement stmt)
(.executeUpdate ^PreparedStatement stmt)
(.executeUpdate stmt sql))})))
(catch Throwable e
(throw (ex-info (tru "Error executing write query: {0}" (ex-message e))
{:sql sql, :params params, :type qp.error-type/invalid-query}
e))))) | |
+----------------------------------------------------------------------------------------------------------------+ | Convenience Imports from Old Impl | +----------------------------------------------------------------------------------------------------------------+ | |
#_{:clj-kondo/ignore [:deprecated-var]}
(p/import-vars
[sql-jdbc.execute.old
connection-with-timezone
set-timezone-sql]) | |
Code related to capturing diagnostic information for JDBC connection pools at execution time. | (ns metabase.driver.sql-jdbc.execute.diagnostic (:import (com.mchange.v2.c3p0 PoolBackedDataSource))) |
(set! *warn-on-reflection* true) | |
Atom used to hold diagnostic info for the current query execution, to be made available via a helper macro/fn below. | (def ^:private ^:dynamic *diagnostic-info* nil) |
Execute | (defn do-with-diagnostic-info
{:style/indent 0}
[f]
(binding [*diagnostic-info* (atom {})]
(f (partial deref *diagnostic-info*)))) |
Execute ```
(sql-jdbc.execute.diagnostic/capturing-diagnostic-info [diag-info-fn]
;; various body forms
;; fetch the diagnostic info, which should be available if execute code called | (defmacro capturing-diagnostic-info
{:style/indent 1}
[[diagnostic-info-fn-binding] & body]
`(do-with-diagnostic-info (fn [~diagnostic-info-fn-binding] ~@body))) |
Captures diagnostic info related to the given
| (defn record-diagnostic-info-for-pool!
[driver database-id ^PoolBackedDataSource datasource]
(when *diagnostic-info*
(swap! *diagnostic-info* #(assoc % ::database-id database-id
::driver driver
::active-connections (.getNumBusyConnectionsAllUsers datasource)
::total-connections (.getNumConnectionsAllUsers datasource)
::threads-waiting (.getNumThreadsAwaitingCheckoutDefaultUser datasource))))) |
Implementations of | (ns metabase.driver.sql-jdbc.execute.legacy-impl (:require [java-time.api :as t] [metabase.driver :as driver] [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute] [metabase.util.date-2 :as u.date] [metabase.util.log :as log]) (:import (java.sql PreparedStatement ResultSet Types) (java.time LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime ZonedDateTime) (java.util Calendar TimeZone))) |
(set! *warn-on-reflection* true) | |
TODO - need to do a legacy implementation using the new methods as well... | |
method impls for JDBC drivers that aren't fully JDBC 4.2 compliant/don't support the new | (driver/register! ::use-legacy-classes-for-read-and-set, :abstract? true) |
(defmethod sql-jdbc.execute/set-parameter [::use-legacy-classes-for-read-and-set LocalDate]
[_ ^PreparedStatement ps ^Integer i t]
(let [t (t/sql-date t)]
(log/tracef "(.setDate ps %d ^%s %s)" i (.getName (class t)) (pr-str t))
(.setDate ps i t))) | |
(defmethod sql-jdbc.execute/set-parameter [::use-legacy-classes-for-read-and-set LocalDateTime]
[_ ^PreparedStatement ps ^Integer i t]
(let [t (t/sql-timestamp t)]
(log/tracef "(.setTimestamp %d ^%s %s)" i (.getName (class t)) (pr-str t))
(.setTimestamp ps i t))) | |
(defmethod sql-jdbc.execute/set-parameter [::use-legacy-classes-for-read-and-set LocalTime]
[_ ^PreparedStatement ps ^Integer i t]
(let [t (t/sql-time t)]
(log/tracef "(.setTime %d ^%s %s)" i (.getName (class t)) (pr-str t))
(.setTime ps i t))) | |
(defmethod sql-jdbc.execute/set-parameter [::use-legacy-classes-for-read-and-set OffsetTime]
[_ ^PreparedStatement ps ^Integer i t]
(let [cal (Calendar/getInstance (TimeZone/getTimeZone (t/zone-id t)))
t (t/sql-time t)]
(log/tracef "(.setTime %d ^%s %s <%s Calendar>)" i (.getName (class t)) (pr-str t) (.. cal getTimeZone getID))
(.setTime ps i t cal))) | |
(defmethod sql-jdbc.execute/set-parameter [::use-legacy-classes-for-read-and-set OffsetDateTime]
[_ ^PreparedStatement ps ^Integer i t]
(let [cal (Calendar/getInstance (TimeZone/getTimeZone (t/zone-id t)))
t (t/sql-timestamp t)]
(log/tracef "(.setTimestamp %d ^%s %s <%s Calendar>)" i (.getName (class t)) (pr-str t) (.. cal getTimeZone getID))
(.setTimestamp ps i t cal))) | |
(defmethod sql-jdbc.execute/set-parameter [::use-legacy-classes-for-read-and-set ZonedDateTime]
[_ ^PreparedStatement ps ^Integer i t]
(let [cal (Calendar/getInstance (TimeZone/getTimeZone (t/zone-id t)))
t (t/sql-timestamp t)]
(log/tracef "(.setTimestamp %d ^%s %s <%s Calendar>)" i (.getName (class t)) (pr-str t) (.. cal getTimeZone getID))
(.setTimestamp ps i t cal))) | |
(defmethod sql-jdbc.execute/read-column-thunk [::use-legacy-classes-for-read-and-set Types/TIME]
[_ ^ResultSet rs _ ^Integer i]
(fn []
(when-let [s (.getString rs i)]
(let [t (u.date/parse s)]
(log/tracef "(.getString rs i) [TIME] -> %s -> %s" (pr-str s) (pr-str t))
t)))) | |
(defmethod sql-jdbc.execute/read-column-thunk [::use-legacy-classes-for-read-and-set Types/DATE]
[_ ^ResultSet rs _ ^Integer i]
(fn []
(when-let [s (.getString rs i)]
(let [t (u.date/parse s)]
(log/tracef "(.getString rs i) [DATE] -> %s -> %s" (pr-str s) (pr-str t))
t)))) | |
(defmethod sql-jdbc.execute/read-column-thunk [::use-legacy-classes-for-read-and-set Types/TIMESTAMP]
[_ ^ResultSet rs _ ^Integer i]
(fn []
(when-let [s (.getString rs i)]
(let [t (u.date/parse s)]
(log/tracef "(.getString rs i) [TIMESTAMP] -> %s -> %s" (pr-str s) (pr-str t))
t)))) | |
(doseq [dispatch-val (keys (methods sql-jdbc.execute/read-column-thunk))
:when (sequential? dispatch-val)
:let [[driver jdbc-type] dispatch-val]
:when (= driver ::use-legacy-classes-for-read-and-set)]
(prefer-method sql-jdbc.execute/read-column-thunk dispatch-val [:sql-jdbc jdbc-type])) | |
Old implementations of [[metabase.driver.sql-jdbc.execute]] methods. All methods and functions in this namespace should be considered deprecated and will be removed in future releases. | (ns metabase.driver.sql-jdbc.execute.old-impl (:require [metabase.driver :as driver])) |
(set! *warn-on-reflection* true) | |
Deprecated in Metabase 47. Implement [[metabase.driver.sql-jdbc.execute/do-with-connection-with-options]] instead. This method will be removed in or after Metabase 50. | (defmulti connection-with-timezone
{:added "0.35.0", :deprecated "0.47.0", :arglists '(^java.sql.Connection [driver database ^String timezone-id])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Return a format string containing a SQL statement to be used to set the timezone for the current transaction.
The "SET @@session.time_zone = %s;" This method is only called for drivers using the default implementation of [[metabase.driver.sql-jdbc.execute/do-with-connection-with-options]]; it should be considered deprecated in favor of implementing [[metabase.driver.sql-jdbc.execute/do-with-connection-with-options]] directly. | (defmulti set-timezone-sql
{:added "0.35.0", :deprecated "0.35.0", :arglists '([driver])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(defmethod set-timezone-sql :sql-jdbc [_] nil) | |
Implementations for sync-related driver multimethods for SQL JDBC drivers, using JDBC DatabaseMetaData. | (ns metabase.driver.sql-jdbc.sync
(:require
[metabase.driver.sql-jdbc.sync.dbms-version :as sql-jdbc.dbms-version]
[metabase.driver.sql-jdbc.sync.describe-database
:as sql-jdbc.describe-database]
[metabase.driver.sql-jdbc.sync.describe-table
:as sql-jdbc.describe-table]
[metabase.driver.sql-jdbc.sync.interface :as sql-jdbc.sync.interface]
[potemkin :as p])) |
(comment sql-jdbc.dbms-version/keep-me sql-jdbc.sync.interface/keep-me sql-jdbc.describe-database/keep-me sql-jdbc.describe-table/keep-me) | |
#_{:clj-kondo/ignore [:deprecated-var]}
(p/import-vars
[sql-jdbc.sync.interface
active-tables
column->semantic-type
database-type->base-type
db-default-timezone
describe-nested-field-columns
excluded-schemas
fallback-metadata-query
filtered-syncable-schemas
have-select-privilege?]
[sql-jdbc.describe-table
add-table-pks
describe-table
describe-table-fields
describe-table-fks
describe-table-indexes
get-catalogs
pattern-based-database-type->base-type]
[sql-jdbc.describe-database
describe-database
fast-active-tables
post-filtered-active-tables]
[sql-jdbc.dbms-version
dbms-version]) | |
(ns metabase.driver.sql-jdbc.sync.common (:require [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute]) (:import (java.sql Connection PreparedStatement ResultSet))) | |
(set! *warn-on-reflection* true) | |
Create a PreparedStatement for metadata queries; set | (defn prepare-statement
^PreparedStatement [driver ^Connection conn ^String sql params]
;; `sql-jdbc.execute/prepared-statement` will set `TYPE_FORWARD_ONLY`/`CONCUR_READ_ONLY`/`FETCH_FORWARD` if
;; possible, although I'm not sure if that will make a difference if we don't actually realize the ResultSet
(doto ^PreparedStatement (sql-jdbc.execute/prepared-statement driver conn sql params)
(.setMaxRows 0))) |
Creates an (rs->row-thunk rs)-> row-thunk
(reducible-results
;; | (defn reducible-results
[rs-thunk rs->row-thunk]
(reify clojure.lang.IReduceInit
(reduce [_ rf init]
(with-open [^ResultSet rs (rs-thunk)]
(reduce
((take-while some?) rf)
init
(let [row-thunk (rs->row-thunk rs)]
(repeatedly #(when (.next rs)
(row-thunk))))))))) |
(ns metabase.driver.sql-jdbc.sync.dbms-version (:require [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute])) | |
(set! *warn-on-reflection* true) | |
Default implementation of | (defn dbms-version
[driver jdbc-spec]
(sql-jdbc.execute/do-with-connection-with-options
driver
jdbc-spec
nil
(fn [^java.sql.Connection conn]
(let [metadata (.getMetaData conn)]
{:flavor (.getDatabaseProductName metadata)
:version (.getDatabaseProductVersion metadata)
:semantic-version [(.getDatabaseMajorVersion metadata)
(.getDatabaseMinorVersion metadata)]})))) |
SQL JDBC impl for | (ns metabase.driver.sql-jdbc.sync.describe-database (:require [clojure.string :as str] [metabase.driver :as driver] [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute] [metabase.driver.sql-jdbc.sync.common :as sql-jdbc.sync.common] [metabase.driver.sql-jdbc.sync.interface :as sql-jdbc.sync.interface] [metabase.driver.sql.query-processor :as sql.qp] [metabase.driver.sync :as driver.s] [metabase.driver.util :as driver.u] [metabase.lib.metadata :as lib.metadata] [metabase.models.interface :as mi] [metabase.query-processor.store :as qp.store] [metabase.util.honey-sql-2 :as h2x] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms]) (:import (java.sql Connection DatabaseMetaData ResultSet))) |
(set! *warn-on-reflection* true) | |
(defmethod sql-jdbc.sync.interface/excluded-schemas :sql-jdbc [_] nil) | |
Get a reducible sequence of all string schema names for the current database from its JDBC database metadata. | (defn all-schemas
[^DatabaseMetaData metadata]
{:added "0.39.0", :pre [(instance? DatabaseMetaData metadata)]}
(sql-jdbc.sync.common/reducible-results
#(.getSchemas metadata)
(fn [^ResultSet rs]
#(.getString rs "TABLE_SCHEM")))) |
(defmethod sql-jdbc.sync.interface/filtered-syncable-schemas :sql-jdbc
[driver _ metadata schema-inclusion-patterns schema-exclusion-patterns]
(eduction (remove (set (sql-jdbc.sync.interface/excluded-schemas driver)))
;; remove the persisted_model schemas
(remove (fn [schema] (re-find #"^metabase_cache.*" schema)))
(filter (partial driver.s/include-schema? schema-inclusion-patterns schema-exclusion-patterns))
(all-schemas metadata))) | |
(mu/defn simple-select-probe-query :- [:cat ms/NonBlankString [:* :any]]
"Simple (ie. cheap) SELECT on a given table to test for access and get column metadata. Doesn't return
anything useful (only used to check whether we can execute a SELECT query)
(simple-select-probe-query :postgres \"public\" \"my_table\")
;; -> [\"SELECT TRUE FROM public.my_table WHERE 1 <> 1 LIMIT 0\"]"
[driver :- :keyword
schema :- [:maybe :string] ; I think technically some DBs like SQL Server support empty schema and table names
table :- :string]
;; Using our SQL compiler here to get portable LIMIT (e.g. `SELECT TOP n ...` for SQL Server/Oracle)
(let [tru (sql.qp/->honeysql driver true)
table (sql.qp/->honeysql driver (h2x/identifier :table schema table))
honeysql {:select [[tru :_]]
:from [[table]]
:where [:inline [:not= 1 1]]}
honeysql (sql.qp/apply-top-level-clause driver :limit honeysql {:limit 0})]
(sql.qp/format-honeysql driver honeysql))) | |
Execute the simple SELECT query defined above. The main goal here is to check whether we're able to execute a SELECT query against the Table in question -- we don't care about the results themselves -- so the query and the logic around executing it should be as simple as possible. We need to highly optimize this logic because it's executed for every Table on every sync. | (defn- execute-select-probe-query
[driver ^Connection conn [sql & params]]
{:pre [(string? sql)]}
(with-open [stmt (sql-jdbc.sync.common/prepare-statement driver conn sql params)]
(log/tracef "[%s] %s" (name driver) sql)
;; attempting to execute the SQL statement will throw an Exception if we don't have permissions; otherwise it will
;; truthy wheter or not it returns a ResultSet, but we can ignore that since we have enough info to proceed at
;; this point.
(.execute stmt))) |
(defmethod sql-jdbc.sync.interface/have-select-privilege? :sql-jdbc
[driver ^Connection conn table-schema table-name]
;; Query completes = we have SELECT privileges
;; Query throws some sort of no permissions exception = no SELECT privileges
(let [sql-args (simple-select-probe-query driver table-schema table-name)]
(log/tracef "Checking for SELECT privileges for %s with query %s"
(str (when table-schema
(str (pr-str table-schema) \.))
(pr-str table-name))
(pr-str sql-args))
(try
(execute-select-probe-query driver conn sql-args)
(log/trace "SELECT privileges confirmed")
true
(catch Throwable e
(log/trace e "Assuming no SELECT privileges: caught exception")
(when-not (.getAutoCommit conn)
(.rollback conn))
false)))) | |
Fetch a JDBC Metadata ResultSet of tables in the DB, optionally limited to ones belonging to a given schema. Returns a reducible sequence of results. | (defn db-tables
[driver ^DatabaseMetaData metadata ^String schema-or-nil ^String db-name-or-nil]
(with-open [rset (.getTables metadata db-name-or-nil (some->> schema-or-nil (driver/escape-entity-name-for-metadata driver)) "%"
(into-array String ["TABLE" "PARTITIONED TABLE" "VIEW" "FOREIGN TABLE" "MATERIALIZED VIEW"
"EXTERNAL TABLE" "DYNAMIC_TABLE"]))]
(loop [acc []]
(if-not (.next rset)
acc
(recur (conj acc {:name (.getString rset "TABLE_NAME")
:schema (.getString rset "TABLE_SCHEM")
:description (when-let [remarks (.getString rset "REMARKS")]
(when-not (str/blank? remarks)
remarks))
:type (.getString rset "TABLE_TYPE")})))))) |
(defn- schema+table-with-select-privileges
[driver database]
(->> (driver/current-user-table-privileges driver database)
(filter #(true? (:select %)))
(map (fn [{:keys [schema table]}]
[schema table]))
set)) | |
Returns a function that take a map with 3 keys [:schema, :name, :type], return true if we can do a select query on the table. This function shouldn't be called a (let [have-select-privilege-fn* (have-select-privilege-fn driver database conn) tables ...] (filter have-select-privilege-fn* tables)) | (defn- have-select-privilege-fn
[driver database conn]
;; `sql-jdbc.sync.interface/have-select-privilege?` is slow because we're doing a SELECT query on each table
;; It's basically a N+1 operation where N is the number of tables in the database
(if (driver/database-supports? driver :table-privileges database)
(let [schema+table-with-select-privileges (schema+table-with-select-privileges driver database)]
(fn [{schema :schema table :name ttype :type}]
;; driver/current-user-table-privileges does not return privileges for external table on redshift, and foreign
;; table on postgres, so we need to use the select method on them
(if (#{[:redshift "EXTERNAL TABLE"] [:postgres "FOREIGN TABLE"]}
[driver ttype])
(sql-jdbc.sync.interface/have-select-privilege? driver conn schema table)
(contains? schema+table-with-select-privileges [schema table]))))
(fn [{schema :schema table :name}]
(sql-jdbc.sync.interface/have-select-privilege? driver conn schema table)))) |
Default, fast implementation of This is as much as 15x faster for Databases with lots of system tables than | (defn fast-active-tables
[driver database ^Connection conn & [db-name-or-nil schema-inclusion-filters schema-exclusion-filters]]
{:pre [(instance? Connection conn)]}
(let [metadata (.getMetaData conn)
syncable-schemas (sql-jdbc.sync.interface/filtered-syncable-schemas driver conn metadata
schema-inclusion-filters schema-exclusion-filters)
have-select-privilege-fn? (have-select-privilege-fn driver database conn)]
(eduction (mapcat (fn [schema]
(->> (db-tables driver metadata schema db-name-or-nil)
(filter have-select-privilege-fn?)
(map #(dissoc % :type))))) syncable-schemas))) |
(defmethod sql-jdbc.sync.interface/active-tables :sql-jdbc [driver database connection schema-inclusion-filters schema-exclusion-filters] (fast-active-tables driver database connection nil schema-inclusion-filters schema-exclusion-filters)) | |
Alternative implementation of | (defn post-filtered-active-tables
[driver database ^Connection conn & [db-name-or-nil schema-inclusion-filters schema-exclusion-filters]]
{:pre [(instance? Connection conn)]}
(let [have-select-privilege-fn? (have-select-privilege-fn driver database conn)]
(eduction
(comp
(filter (let [excluded (sql-jdbc.sync.interface/excluded-schemas driver)]
(fn [{table-schema :schema :as table}]
(and (not (contains? excluded table-schema))
(driver.s/include-schema? schema-inclusion-filters schema-exclusion-filters table-schema)
(have-select-privilege-fn? table)))))
(map #(dissoc % :type)))
(db-tables driver (.getMetaData conn) nil db-name-or-nil)))) |
(defn- db-or-id-or-spec->database [db-or-id-or-spec]
(cond (mi/instance-of? :model/Database db-or-id-or-spec)
db-or-id-or-spec
(int? db-or-id-or-spec)
(qp.store/with-metadata-provider db-or-id-or-spec
(lib.metadata/database (qp.store/metadata-provider)))
:else
nil)) | |
Default implementation of [[metabase.driver/describe-database]] for SQL JDBC drivers. Uses JDBC DatabaseMetaData. | (mu/defn describe-database
[driver :- :keyword
db-or-id-or-spec :- [:or :int :map]]
{:tables
(sql-jdbc.execute/do-with-connection-with-options
driver
db-or-id-or-spec
nil
(fn [^Connection conn]
(let [schema-filter-prop (driver.u/find-schema-filters-prop driver)
has-schema-filter-prop? (some? schema-filter-prop)
database (db-or-id-or-spec->database db-or-id-or-spec)
default-active-tbl-fn #(into #{} (sql-jdbc.sync.interface/active-tables driver database conn nil nil))]
(if has-schema-filter-prop?
;; TODO: the else of this branch seems uncessary, why do you want to call describe-database on a database that
;; does not exists?
(if (some? database)
(let [prop-nm (:name schema-filter-prop)
[inclusion-patterns exclusion-patterns] (driver.s/db-details->schema-filter-patterns
prop-nm
database)]
(into #{} (sql-jdbc.sync.interface/active-tables driver database conn inclusion-patterns exclusion-patterns)))
(default-active-tbl-fn))
(default-active-tbl-fn)))))}) |
SQL JDBC impl for | (ns metabase.driver.sql-jdbc.sync.describe-table
(:require
[cheshire.core :as json]
[clojure.java.jdbc :as jdbc]
[clojure.set :as set]
[clojure.string :as str]
[medley.core :as m]
[metabase.db.metadata-queries :as metadata-queries]
[metabase.driver :as driver]
[metabase.driver.sql-jdbc.connection :as sql-jdbc.conn]
[metabase.driver.sql-jdbc.execute :as sql-jdbc.execute]
[metabase.driver.sql-jdbc.sync.common :as sql-jdbc.sync.common]
[metabase.driver.sql-jdbc.sync.interface :as sql-jdbc.sync.interface]
[metabase.driver.sql.query-processor :as sql.qp]
[metabase.lib.schema.literal :as lib.schema.literal]
[metabase.models :refer [Field]]
[metabase.models.table :as table]
[metabase.util :as u]
[metabase.util.honey-sql-2 :as h2x]
[metabase.util.log :as log]
[metabase.util.malli.registry :as mr]
#_{:clj-kondo/ignore [:discouraged-namespace]}
[toucan2.core :as t2])
(:import
(java.sql Connection DatabaseMetaData ResultSet))) |
(set! *warn-on-reflection* true) | |
(defmethod sql-jdbc.sync.interface/column->semantic-type :sql-jdbc [_driver _database-type _column-name] nil) | |
Return a | (defn pattern-based-database-type->base-type
[pattern->type]
(fn database-type->base-type [column-type]
(let [column-type (name column-type)]
(some
(fn [[pattern base-type]]
(when (re-find pattern column-type)
base-type))
pattern->type)))) |
Returns a set of all of the catalogs found via | (defn get-catalogs
[^DatabaseMetaData metadata]
(with-open [rs (.getCatalogs metadata)]
(set (map :table_cat (jdbc/metadata-result rs))))) |
Given a | (defn- database-type->base-type-or-warn
[driver database-type]
(or (sql-jdbc.sync.interface/database-type->base-type driver (keyword database-type))
(do (log/warn (format "Don't know how to map column type '%s' to a Field base_type, falling back to :type/*."
database-type))
:type/*))) |
Get an appropriate semantic type for a column with | (defn- calculated-semantic-type
[driver ^String column-name ^String database-type]
(when-let [semantic-type (sql-jdbc.sync.interface/column->semantic-type driver database-type column-name)]
(assert (isa? semantic-type :type/*)
(str "Invalid type: " semantic-type))
semantic-type)) |
(defmethod sql-jdbc.sync.interface/fallback-metadata-query :sql-jdbc
[driver db-name-or-nil schema-name table-name]
{:pre [(string? table-name)]}
;; Using our SQL compiler here to get portable LIMIT (e.g. `SELECT TOP n ...` for SQL Server/Oracle)
(let [table (sql.qp/->honeysql driver (h2x/identifier :table db-name-or-nil schema-name table-name))
honeysql {:select [:*]
:from [[table]]
:where [:not= (sql.qp/inline-num 1) (sql.qp/inline-num 1)]}
honeysql (sql.qp/apply-top-level-clause driver :limit honeysql {:limit 0})]
(sql.qp/format-honeysql driver honeysql))) | |
In some rare cases | (defn fallback-fields-metadata-from-select-query
[driver ^Connection conn db-name-or-nil schema table]
;; some DBs (:sqlite) don't actually return the correct metadata for LIMIT 0 queries
(let [[sql & params] (sql-jdbc.sync.interface/fallback-metadata-query driver db-name-or-nil schema table)]
(reify clojure.lang.IReduceInit
(reduce [_ rf init]
(with-open [stmt (sql-jdbc.sync.common/prepare-statement driver conn sql params)
rs (.executeQuery stmt)]
(let [metadata (.getMetaData rs)]
(reduce
((map (fn [^Integer i]
;; TODO: missing :database-required column as ResultSetMetadata does not have information about
;; the default value of a column, so we can't make sure whether a column is required or not
{:name (.getColumnName metadata i)
:database-type (.getColumnTypeName metadata i)
:database-is-auto-increment (.isAutoIncrement metadata i)})) rf)
init
(range 1 (inc (.getColumnCount metadata)))))))))) |
Reducible metadata about the Fields belonging to a Table, fetching using JDBC DatabaseMetaData methods. | (defn- jdbc-fields-metadata
[driver ^Connection conn db-name-or-nil schema table-name]
(sql-jdbc.sync.common/reducible-results
#(.getColumns (.getMetaData conn)
db-name-or-nil
(some->> schema (driver/escape-entity-name-for-metadata driver))
(some->> table-name (driver/escape-entity-name-for-metadata driver))
nil)
(fn [^ResultSet rs]
;; https://docs.oracle.com/javase/7/docs/api/java/sql/DatabaseMetaData.html#getColumns(java.lang.String,%20java.lang.String,%20java.lang.String,%20java.lang.String)
#(let [default (.getString rs "COLUMN_DEF")
no-default? (contains? #{nil "NULL" "null"} default)
nullable (.getInt rs "NULLABLE")
not-nullable? (= 0 nullable)
;; IS_AUTOINCREMENT could return nil
auto-increment (.getString rs "IS_AUTOINCREMENT")
auto-increment? (= "YES" auto-increment)
no-auto-increment? (= "NO" auto-increment)
column-name (.getString rs "COLUMN_NAME")
required? (and no-default? not-nullable? no-auto-increment?)]
(merge
{:name column-name
:database-type (.getString rs "TYPE_NAME")
:database-is-auto-increment auto-increment?
:database-required required?}
(when-let [remarks (.getString rs "REMARKS")]
(when-not (str/blank? remarks)
{:field-comment remarks}))))))) |
(defn ^:private fields-metadata
[driver ^Connection conn {schema :schema, table-name :name} ^String db-name-or-nil]
{:pre [(instance? Connection conn) (string? table-name)]}
(reify clojure.lang.IReduceInit
(reduce [_ rf init]
;; 1. Return all the Fields that come back from DatabaseMetaData that include type info.
;;
;; 2. Iff there are some Fields that don't have type info, concatenate
;; `fallback-fields-metadata-from-select-query`, which fetches the same Fields using a different method.
;;
;; 3. Filter out any duplicates between the two methods using `m/distinct-by`.
(let [has-fields-without-type-info? (volatile! false)
;; intented to fix syncing dynamic tables for snowflake.
;; currently there is a bug in snowflake jdbc (snowflake#1574) in which it doesn't return columns for dynamic tables
jdbc-returns-no-field? (volatile! true)
jdbc-metadata (eduction
(remove (fn [{:keys [database-type]}]
(when @jdbc-returns-no-field?
(vreset! jdbc-returns-no-field? false))
(when (str/blank? database-type)
(vreset! has-fields-without-type-info? true)
true)))
(jdbc-fields-metadata driver conn db-name-or-nil schema table-name))
fallback-metadata (reify clojure.lang.IReduceInit
(reduce [_ rf init]
(reduce
rf
init
(when (or @jdbc-returns-no-field? @has-fields-without-type-info?)
(fallback-fields-metadata-from-select-query driver conn db-name-or-nil schema table-name)))))]
;; VERY IMPORTANT! DO NOT REWRITE THIS TO BE LAZY! IT ONLY WORKS BECAUSE AS NORMAL-FIELDS GETS REDUCED,
;; HAS-FIELDS-WITHOUT-TYPE-INFO? WILL GET SET TO TRUE IF APPLICABLE AND THEN FALLBACK-FIELDS WILL RUN WHEN
;; IT'S TIME TO START EVALUATING THAT.
(reduce
((comp cat (m/distinct-by :name)) rf)
init
[jdbc-metadata fallback-metadata]))))) | |
Returns a transducer for computing metadata about the fields in | (defn describe-table-fields-xf
[driver table]
(map-indexed (fn [i {:keys [database-type], column-name :name, :as col}]
(let [base-type (database-type->base-type-or-warn driver database-type)
semantic-type (calculated-semantic-type driver column-name database-type)
db (table/database table)
json? (isa? base-type :type/JSON)]
(merge
(u/select-non-nil-keys col [:name :database-type :field-comment :database-required :database-is-auto-increment])
{:base-type base-type
:database-position i
;; json-unfolding is true by default for JSON fields, but this can be overridden at the DB level
:json-unfolding json?}
(when semantic-type
{:semantic-type semantic-type})
(when (and json? (driver/database-supports? driver :nested-field-columns db))
{:visibility-type :details-only})))))) |
Returns a set of column metadata for | (defmulti describe-table-fields
{:added "0.45.0"
:arglists '([driver ^Connection conn table ^String db-name-or-nil])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(defmethod describe-table-fields :sql-jdbc
[driver conn table db-name-or-nil]
(into
#{}
(describe-table-fields-xf driver table)
(fields-metadata driver conn table db-name-or-nil))) | |
Returns a vector of primary keys for Note: If db-name, schema, and table-name are not passed, this may return all pks that the metadata's connection can access. | (defmulti get-table-pks
{:changelog-test/ignore true
:added "0.45.0"
:arglists '([driver ^Connection conn db-name-or-nil table])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(defmethod get-table-pks :default
[_driver ^Connection conn db-name-or-nil table]
(let [^DatabaseMetaData metadata (.getMetaData conn)]
(into [] (sql-jdbc.sync.common/reducible-results
#(.getPrimaryKeys metadata db-name-or-nil (:schema table) (:name table))
(fn [^ResultSet rs] #(.getString rs "COLUMN_NAME")))))) | |
Using | (defn add-table-pks
[driver ^Connection conn db-name-or-nil table]
(let [pks (set (get-table-pks driver conn db-name-or-nil table))]
(update table :fields (fn [fields]
(set (for [field fields]
(if-not (contains? pks (:name field))
field
(assoc field :pk? true)))))))) |
(defn- describe-table*
([driver ^Connection conn table]
(describe-table* driver conn nil table))
([driver ^Connection conn db-name-or-nil table]
{:pre [(instance? Connection conn)]}
(->> (assoc (select-keys table [:name :schema])
:fields (describe-table-fields driver conn table nil))
;; find PKs and mark them
(add-table-pks driver conn db-name-or-nil)))) | |
Default implementation of | (defn describe-table
[driver db-or-id-or-spec-or-conn table]
(if (instance? Connection db-or-id-or-spec-or-conn)
(describe-table* driver db-or-id-or-spec-or-conn table)
(sql-jdbc.execute/do-with-connection-with-options
driver
db-or-id-or-spec-or-conn
nil
(fn [^Connection conn]
(describe-table* driver conn table))))) |
(defn- describe-table-fks*
[_driver ^Connection conn {^String schema :schema, ^String table-name :name} & [^String db-name-or-nil]]
(into
#{}
(sql-jdbc.sync.common/reducible-results #(.getImportedKeys (.getMetaData conn) db-name-or-nil schema table-name)
(fn [^ResultSet rs]
(fn []
{:fk-column-name (.getString rs "FKCOLUMN_NAME")
:dest-table {:name (.getString rs "PKTABLE_NAME")
:schema (.getString rs "PKTABLE_SCHEM")}
:dest-column-name (.getString rs "PKCOLUMN_NAME")}))))) | |
Default implementation of [[metabase.driver/describe-table-fks]] for SQL JDBC drivers. Uses JDBC DatabaseMetaData. | (defn describe-table-fks
[driver db-or-id-or-spec-or-conn table & [db-name-or-nil]]
(if (instance? Connection db-or-id-or-spec-or-conn)
(describe-table-fks* driver db-or-id-or-spec-or-conn table db-name-or-nil)
(sql-jdbc.execute/do-with-connection-with-options
driver
db-or-id-or-spec-or-conn
nil
(fn [^Connection conn]
(describe-table-fks* driver conn table db-name-or-nil))))) |
Default implementation of [[metabase.driver/describe-table-indexes]] for SQL JDBC drivers. Uses JDBC DatabaseMetaData. | (defn describe-table-indexes
[driver db table]
(sql-jdbc.execute/do-with-connection-with-options
driver
db
nil
(fn [^Connection conn]
;; https://docs.oracle.com/javase/8/docs/api/java/sql/DatabaseMetaData.html#getIndexInfo-java.lang.String-java.lang.String-java.lang.String-boolean-boolean-
(with-open [index-info-rs (.getIndexInfo (.getMetaData conn)
nil ;; catalog
(:schema table)
(:name table)
;; when true, return only indices for unique values when
;; false, return indices regardless of whether unique or not
false
;; when true, result is allowed to reflect approximate or out of data
;; values. when false, results are requested to be accurate
false)]
(->> (vals (group-by :index_name (into []
;; filtered indexes are ignored
(filter #(nil? (:filter_condition %)))
(jdbc/reducible-result-set index-info-rs {}))))
(keep (fn [idx-values]
;; we only sync columns that are either singlely indexed or is the first key in a composite index
(when-let [index-name (some :column_name (sort-by :ordinal_position idx-values))]
{:type :normal-column-index
:value index-name})))
set))))) |
Max string length for a row for nested field column before we just give up on parsing it. Marked as mutable because we mutate it for tests. | (def ^:dynamic *nested-field-column-max-row-length* 50000) |
(defn- flattened-row [field-name row]
(letfn [(flatten-row [row path]
(lazy-seq
(when-let [[[k v] & xs] (seq row)]
(cond (and (map? v) (not-empty v))
(into (flatten-row v (conj path k))
(flatten-row xs path))
:else
(cons [(conj path k) v]
(flatten-row xs path))))))]
(into {} (flatten-row row [field-name])))) | |
Returns whether a string can be parsed to an ISO 8601 datetime or not. | (def ^:private ^{:arglists '([s])} can-parse-datetime?
(mr/validator ::lib.schema.literal/string.datetime)) |
Mostly just (type member) but with a bit to suss out strings which are ISO8601 and say that they are datetimes | (defn- type-by-parsing-string
[member]
(let [member-type (type member)]
(if (and (instance? String member)
(can-parse-datetime? member))
java.time.LocalDateTime
member-type))) |
(defn- row->types [row]
(into {} (for [[field-name field-val] row
;; We put top-level array row type semantics on JSON roadmap but skip for now
:when (map? field-val)]
(let [flat-row (flattened-row field-name field-val)]
(into {} (map (fn [[k v]] [k (type-by-parsing-string v)]) flat-row)))))) | |
(defn- describe-json-xform [member]
((comp (map #(for [[k v] %
:when (< (count v) *nested-field-column-max-row-length*)]
[k (json/parse-string v)]))
(map #(into {} %))
(map row->types)) member)) | |
Maximum number of nested field columns. | (def ^:const max-nested-field-columns 100) |
Reducing function that takes a bunch of maps from row->types, and gets them to conform to the type hierarchy, going through and taking the lowest common denominator type at each pass, ignoring the nils. | (defn- describe-json-rf
([] nil)
([acc-field-type-map] acc-field-type-map)
([acc-field-type-map second-field-type-map]
(into {}
(for [json-column (set/union (set (keys second-field-type-map))
(set (keys acc-field-type-map)))]
(cond
(or (nil? acc-field-type-map)
(nil? (acc-field-type-map json-column))
(= (hash (acc-field-type-map json-column))
(hash (second-field-type-map json-column))))
[json-column (second-field-type-map json-column)]
(or (nil? second-field-type-map)
(nil? (second-field-type-map json-column)))
[json-column (acc-field-type-map json-column)]
(every? #(isa? % Number) [(acc-field-type-map json-column)
(second-field-type-map json-column)])
[json-column java.lang.Number]
(every?
(fn [column-type]
(some (fn [allowed-type]
(isa? column-type allowed-type))
[String Number Boolean java.time.LocalDateTime]))
[(acc-field-type-map json-column) (second-field-type-map json-column)])
[json-column java.lang.String]
:else
[json-column nil]))))) |
Map from Java types for deserialized JSON (so small subset of Java types) to MBQL types. We actually do deserialize the JSON in order to determine types, so the java / clojure types we get have to be matched to MBQL types | (def field-type-map
{java.lang.String :type/Text
;; JSON itself has the single number type, but Java serde of JSON is stricter
java.lang.Long :type/Integer
clojure.lang.BigInt :type/BigInteger
java.math.BigInteger :type/BigInteger
java.lang.Integer :type/Integer
java.lang.Double :type/Float
java.lang.Float :type/Float
java.math.BigDecimal :type/Decimal
java.lang.Number :type/Number
java.lang.Boolean :type/Boolean
java.time.LocalDateTime :type/DateTime
clojure.lang.PersistentVector :type/Array
clojure.lang.PersistentArrayMap :type/Structured
clojure.lang.PersistentHashMap :type/Structured}) |
Map from MBQL types to database types. This is the lowest common denominator of types, hopefully, although as of writing this is just geared towards Postgres types | (def db-type-map
{:type/Text "text"
:type/Integer "bigint"
;; You might think that the ordinary 'bigint' type in Postgres and MySQL should be this.
;; However, Bigint in those DB's maxes out at 2 ^ 64.
;; JSON, like Javascript itself, will happily represent 1.8 * (10^308),
;; Losing digits merrily along the way.
;; We can't really trust anyone to use MAX_SAFE_INTEGER, in JSON-land..
;; So really without forcing arbitrary precision ('decimal' type),
;; we have too many numerical regimes to test.
;; (#22732) was basically the consequence of missing one.
:type/BigInteger "decimal"
:type/Float "double precision"
:type/Number "double precision"
:type/Decimal "decimal"
:type/Boolean "boolean"
:type/DateTime "timestamp"
:type/Array "text"
:type/Structured "text"}) |
(defn- field-types->fields [field-types]
(let [valid-fields (for [[field-path field-type] (seq field-types)]
(if (nil? field-type)
nil
(let [curr-type (get field-type-map field-type :type/*)]
{:name (str/join " \u2192 " (map name field-path)) ;; right arrow
:database-type (db-type-map curr-type)
:base-type curr-type
;; Postgres JSONB field, which gets most usage, doesn't maintain JSON object ordering...
:database-position 0
:json-unfolding false
:visibility-type :normal
:nfc-path field-path})))
field-hash (apply hash-set (filter some? valid-fields))]
field-hash)) | |
Given a table return a list of json fields that need to unfold. | (defn- table->unfold-json-fields
[driver conn table]
(let [table-fields (describe-table-fields driver conn table nil)
json-fields (filter #(isa? (:base-type %) :type/JSON) table-fields)]
(if-not (seq json-fields)
#{}
(let [existing-fields-by-name (m/index-by :name (t2/select Field :table_id (u/the-id table)))
should-not-unfold? (fn [field]
(when-let [existing-field (existing-fields-by-name (:name field))]
(false? (:json_unfolding existing-field))))]
(remove should-not-unfold? json-fields))))) |
Return a honeysql query used to get row sample to describe json columns. If the table has PKs, try to fetch both first and last rows (see #25744). Else fetch the first n rows only. | (defn- sample-json-row-honey-sql
[table-identifier json-field-identifiers pk-identifiers]
(let [pks-expr (mapv vector pk-identifiers)
table-expr [table-identifier]
json-field-exprs (mapv vector json-field-identifiers)]
(if (seq pk-identifiers)
{:select json-field-exprs
:from [table-expr]
;; mysql doesn't support limit in subquery, so we're using inner join here
:join [[{:union [{:nest {:select pks-expr
:from [table-expr]
:order-by (mapv #(vector % :asc) pk-identifiers)
:limit (/ metadata-queries/nested-field-sample-limit 2)}}
{:nest {:select pks-expr
:from [table-expr]
:order-by (mapv #(vector % :desc) pk-identifiers)
:limit (/ metadata-queries/nested-field-sample-limit 2)}}]}
:result]
(into [:and]
(for [pk-identifier pk-identifiers]
[:=
(h2x/identifier :field :result (last (h2x/identifier->components pk-identifier)))
pk-identifier]))]}
{:select json-field-exprs
:from [table-expr]
:limit metadata-queries/nested-field-sample-limit}))) |
(defn- describe-json-fields
[driver jdbc-spec table json-fields pks]
(let [table-identifier-info [(:schema table) (:name table)]
json-field-identifiers (mapv #(apply h2x/identifier :field (into table-identifier-info [(:name %)])) json-fields)
table-identifier (apply h2x/identifier :table table-identifier-info)
pk-identifiers (when (seq pks)
(mapv #(apply h2x/identifier :field (into table-identifier-info [%])) pks))
sql-args (sql.qp/format-honeysql
driver
(sample-json-row-honey-sql table-identifier json-field-identifiers pk-identifiers))
query (jdbc/reducible-query jdbc-spec sql-args {:identifiers identity})
field-types (transduce describe-json-xform describe-json-rf query)
fields (field-types->fields field-types)]
(if (> (count fields) max-nested-field-columns)
(do
(log/warn
(format
"More nested field columns detected than maximum. Limiting the number of nested field columns to %d."
max-nested-field-columns))
(set (take max-nested-field-columns fields)))
fields))) | |
The name's nested field columns but what the people wanted (issue #708) was JSON so what they're getting is JSON. | (defmethod sql-jdbc.sync.interface/describe-nested-field-columns :sql-jdbc
[driver database table]
(let [jdbc-spec (sql-jdbc.conn/db->pooled-connection-spec database)]
(sql-jdbc.execute/do-with-connection-with-options
driver
jdbc-spec
nil
(fn [^Connection conn]
(let [unfold-json-fields (table->unfold-json-fields driver conn table)
pks (get-table-pks driver conn (:name database) table)]
(if (empty? unfold-json-fields)
#{}
(describe-json-fields driver jdbc-spec table unfold-json-fields pks))))))) |
(ns metabase.driver.sql-jdbc.sync.interface (:require [metabase.driver :as driver])) | |
Return a reducible sequence of maps containing information about the active tables/views, collections, or equivalent
that currently exist in a database. Each map should contain the key Two different implementations are provided in this namespace: | (defmulti active-tables
{:added "0.37.1"
:arglists '([driver
database
^java.sql.Connection connection
^String schema-inclusion-filters
^String schema-exclusion-filters])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Return set of string names of schemas to skip syncing tables from. | (defmulti excluded-schemas
{:added "0.37.1" :arglists '([driver])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Check if we have SELECT privileges for given Default impl is in [[metabase.driver.sql-jdbc.sync.describe-database]]. | (defmulti have-select-privilege?
{:added "0.37.1" :arglists '([driver ^java.sql.Connection connection ^String table-schema ^String table-name])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Return a reducible sequence of string names of schemas that should be synced for the given database. Schemas for
which the current DB user has no | (defmulti filtered-syncable-schemas
{:changelog-test/ignore true
:added "0.43.0"
:arglists '([driver
^java.sql.Connection connection
^java.sql.DatabaseMetaData metadata
^String schema-inclusion-patterns
^String schema-exclusion-patterns])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Given a native DB column type (as a keyword), return the corresponding | (defmulti database-type->base-type
{:added "0.37.1" :arglists '([driver database-type])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Attempt to determine the semantic-type of a field given the column name and native type. For example, the Postgres
driver can mark Postgres JSON type columns as
| (defmulti column->semantic-type
{:added "0.37.1" :arglists '([driver database-type column-name])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
SELECT columns from a given table so we can get column metadata. By default doesn't return any rows. This can be overriden because SQLite is silly and only returns column information for views if the query returns a non-zero number of rows. (fallback-metadata-query :postgres "mydatabase" "public" "mytable") ;; -> ["SELECT * FROM mydatabase.public.mytable WHERE 1 <> 1 LIMIT 0"] | (defmulti fallback-metadata-query
{:added "0.37.1" :arglists '([driver db-name-or-nil schema-name table-name])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
JDBC-specific version of of [[metabase.driver/db-default-timezone]] that takes a [[clojure.java.jdbc]] connection
spec rather than a set of DB details. If an implementation of this method is provided, it will be used automatically
in the default This exists so we can reuse this code with the application database without having to create a new Connection pool for the application DB. DEPRECATED: you can implement [[metabase.driver/db-default-timezone]] directly;
use [[metabase.driver.sql-jdbc.execute/do-with-connection-with-options]] to get a | (defmulti db-default-timezone
{:added "0.38.0", :arglists '([driver jdbc-spec]), :deprecated "0.48.0"}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
#_{:clj-kondo/ignore [:deprecated-var]}
(defmethod db-default-timezone :sql-jdbc
[_driver _jdbc-spec]
nil) | |
Return information about the nestable columns in a | (defmulti describe-nested-field-columns
{:added "0.43.0", :arglists '([driver database table])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(ns metabase.driver.sql.ddl (:require [clojure.java.jdbc :as jdbc] [metabase.driver.ddl.interface :as ddl.i] [metabase.driver.sql.util :as sql.u] [metabase.public-settings :as public-settings])) | |
(defn- quote-fn [driver]
(fn quote [ident entity]
(sql.u/quote-name driver ident (ddl.i/format-name driver entity)))) | |
(defn- add-remark [sql-str]
(str "-- Metabase\n"
sql-str)) | |
(defn- jdbc-spec [connection-or-spec]
(cond
(instance? java.sql.Connection connection-or-spec) {:connection connection-or-spec}
(map? connection-or-spec) connection-or-spec
:else (throw (ex-info "Invalid JDBC connection spec" {:spec connection-or-spec})))) | |
Executes sql and params with a standard remark prepended to the statement. TODO -- move the JDBC stuff to something like [[metabase.driver.sql-jdbc.ddl]]. JDBC-specific stuff does not belong IN [[metabase.driver.sql]] !! | (defn execute! [connection-or-spec [sql & params]] (jdbc/execute! (jdbc-spec connection-or-spec) (into [(add-remark sql)] params))) |
Queries sql and params with a standard remark prepended to the statement. | (defn jdbc-query [connection-or-spec [sql & params]] (jdbc/query (jdbc-spec connection-or-spec) (into [(add-remark sql)] params))) |
SQL string to create a schema suitable | (defn create-schema-sql
[{driver :engine :as database}]
(let [q (quote-fn driver)]
(format "create schema %s"
(q :table (ddl.i/schema-name database (public-settings/site-uuid)))))) |
SQL string to drop a schema suitable | (defn drop-schema-sql
[{driver :engine :as database}]
(let [q (quote-fn driver)]
(format "drop schema if exists %s"
(q :table (ddl.i/schema-name database (public-settings/site-uuid)))))) |
Formats a create table statement within our own cache schema | (defn create-table-sql
[{driver :engine :as database} definition query]
(let [q (quote-fn driver)]
(format "create table %s.%s as %s"
(q :table (ddl.i/schema-name database (public-settings/site-uuid)))
(q :table (:table-name definition))
query))) |
Formats a drop table statement within our own cache schema | (defn drop-table-sql
[{driver :engine :as database} table-name]
(let [q (quote-fn driver)]
(format "drop table if exists %s.%s"
(q :table (ddl.i/schema-name database (public-settings/site-uuid)))
(q :table table-name)))) |
(ns metabase.driver.sql.parameters.substitute
(:require
[clojure.string :as str]
[metabase.driver :as driver]
[metabase.driver.common.parameters :as params]
[metabase.driver.sql.parameters.substitution
:as sql.params.substitution]
[metabase.query-processor.error-type :as qp.error-type]
[metabase.util :as u]
[metabase.util.i18n :refer [tru]]
[metabase.util.log :as log])) | |
(defn- substitute-field-filter [[sql args missing] in-optional? k {:keys [_field value], :as v}]
(if (and (= params/no-value value) in-optional?)
;; no-value field filters inside optional clauses are ignored, and eventually emitted entirely
[sql args (conj missing k)]
;; otherwise no values get replaced with `1 = 1` and other values get replaced normally
(let [{:keys [replacement-snippet prepared-statement-args]}
(sql.params.substitution/->replacement-snippet-info driver/*driver* v)]
[(str sql replacement-snippet) (concat args prepared-statement-args) missing]))) | |
(defn- substitute-card-query [[sql args missing] v]
(let [{:keys [replacement-snippet prepared-statement-args]}
(sql.params.substitution/->replacement-snippet-info driver/*driver* v)]
[(str sql replacement-snippet) (concat args prepared-statement-args) missing])) | |
(defn- substitute-native-query-snippet [[sql args missing] v]
(let [{:keys [replacement-snippet]} (sql.params.substitution/->replacement-snippet-info driver/*driver* v)]
[(str sql replacement-snippet) args missing])) | |
(defn- substitute-param [param->value [sql args missing] in-optional? {:keys [k]}]
(if-not (contains? param->value k)
[sql args (conj missing k)]
(let [v (get param->value k)]
(cond
(params/FieldFilter? v)
(substitute-field-filter [sql args missing] in-optional? k v)
(params/ReferencedCardQuery? v)
(substitute-card-query [sql args missing] v)
(params/ReferencedQuerySnippet? v)
(substitute-native-query-snippet [sql args missing] v)
(= params/no-value v)
[sql args (conj missing k)]
:else
(let [{:keys [replacement-snippet prepared-statement-args]}
(sql.params.substitution/->replacement-snippet-info driver/*driver* v)]
[(str sql replacement-snippet) (concat args prepared-statement-args) missing]))))) | |
(declare substitute*) | |
(defn- substitute-optional [param->value [sql args missing] {subclauses :args}]
(let [[opt-sql opt-args opt-missing] (substitute* param->value subclauses true)]
(if (seq opt-missing)
[sql args missing]
[(str sql opt-sql) (concat args opt-args) missing]))) | |
Returns a sequence of | (defn- substitute*
[param->value parsed in-optional?]
(reduce
(fn [[sql args missing] x]
(cond
(string? x)
[(str sql x) args missing]
(params/Param? x)
(substitute-param param->value [sql args missing] in-optional? x)
(params/Optional? x)
(substitute-optional param->value [sql args missing] x)))
nil
parsed)) |
Substitute (substitute ["select * from foobars where birdtype = " (param "birdtype")] {"bird_type" "Steller's Jay"}) ;; -> ["select * from foobars where bird_type = ?" ["Steller's Jay"]] | (defn substitute
[parsed-query param->value]
(log/tracef "Substituting params\n%s\nin query:\n%s" (u/pprint-to-str param->value) (u/pprint-to-str parsed-query))
(let [[sql args missing] (try
(substitute* param->value parsed-query false)
(catch Throwable e
(throw (ex-info (tru "Unable to substitute parameters: {0}" (ex-message e))
{:type (or (:type (ex-data e)) qp.error-type/qp)
:params param->value
:parsed-query parsed-query}
e))))]
(log/tracef "=>%s\n%s" sql (pr-str args))
(when (seq missing)
(throw (ex-info (tru "Cannot run the query: missing required parameters: {0}" (set missing))
{:type qp.error-type/missing-required-parameter
:missing missing})))
[(str/trim sql) args])) |
These functions take the info for a param fetched by the functions above and add additional info about how that param should be represented as SQL. (Specifically, they return information in this format: {;; appropriate SQL that should be used to replace the param snippet, e.g. {{x}}
:replacement-snippet "= ?"
;; ; any prepared statement args (values for | (ns metabase.driver.sql.parameters.substitution
(:require
[clojure.string :as str]
[metabase.driver :as driver]
[metabase.driver.common.parameters :as params]
[metabase.driver.common.parameters.dates :as params.dates]
[metabase.driver.common.parameters.operators :as params.ops]
[metabase.driver.sql.query-processor :as sql.qp]
[metabase.lib.metadata :as lib.metadata]
[metabase.lib.schema.common :as lib.schema.common]
[metabase.mbql.schema :as mbql.s]
[metabase.mbql.util :as mbql.u]
[metabase.query-processor.error-type :as qp.error-type]
[metabase.query-processor.middleware.wrap-value-literals
:as qp.wrap-value-literals]
[metabase.query-processor.timezone :as qp.timezone]
[metabase.query-processor.util.add-alias-info :as add]
[metabase.util :as u]
[metabase.util.date-2 :as u.date]
[metabase.util.i18n :refer [tru]]
[metabase.util.malli :as mu])
(:import
(clojure.lang IPersistentVector Keyword)
(java.time.temporal Temporal)
(java.util UUID)
(metabase.driver.common.parameters Date DateRange FieldFilter ReferencedCardQuery ReferencedQuerySnippet))) |
------------------------------------ ->prepared-substitution & default impls ------------------------------------- | |
Returns a | (defmulti ->prepared-substitution
{:added "0.34.0" :arglists '([driver x])}
(fn [driver x] [(driver/dispatch-on-initialized-driver driver) (class x)])
:hierarchy #'driver/hierarchy) |
Represents the SQL string replace value (usually ?) and the typed parameter value | (def PreparedStatementSubstitution [:map [:sql-string :string] [:param-values [:maybe [:sequential :any]]]]) |
(mu/defn make-stmt-subs :- PreparedStatementSubstitution
"Create a `PreparedStatementSubstitution` map for `sql-string` and the `param-seq`"
[sql-string param-seq]
{:sql-string sql-string
:param-values param-seq}) | |
Convert X to a replacement snippet info map by passing it to HoneySQL's | (defn- honeysql->prepared-stmt-subs
[driver x]
(let [[snippet & args] (sql.qp/format-honeysql driver x)]
(make-stmt-subs snippet args))) |
(mu/defmethod ->prepared-substitution [:sql nil] :- PreparedStatementSubstitution [driver _] (honeysql->prepared-stmt-subs driver nil)) | |
(mu/defmethod ->prepared-substitution [:sql Object] :- PreparedStatementSubstitution [driver obj] (honeysql->prepared-stmt-subs driver (str obj))) | |
(mu/defmethod ->prepared-substitution [:sql Number] :- PreparedStatementSubstitution [driver num] (honeysql->prepared-stmt-subs driver (sql.qp/inline-num num))) | |
(mu/defmethod ->prepared-substitution [:sql Boolean] :- PreparedStatementSubstitution [driver b] (honeysql->prepared-stmt-subs driver b)) | |
(mu/defmethod ->prepared-substitution [:sql Keyword] :- PreparedStatementSubstitution [driver kwd] (honeysql->prepared-stmt-subs driver kwd)) | |
TIMEZONE FIXME - remove this since we aren't using | (mu/defmethod ->prepared-substitution [:sql Date] :- PreparedStatementSubstitution [_driver date] (make-stmt-subs "?" [date])) |
(mu/defmethod ->prepared-substitution [:sql Temporal] :- PreparedStatementSubstitution [_driver t] (make-stmt-subs "?" [t])) | |
Returns a suitable temporal unit conversion keyword for | (defmulti align-temporal-unit-with-param-type
{:added "0.48.0" :deprecated "0.49.0" :arglists '([driver field param-type])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Returns a suitable temporal unit conversion keyword for | (defmulti align-temporal-unit-with-param-type-and-value
{:added "0.49.0" :arglists '([driver field param-type value])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
#_{:clj-kondo/ignore [:deprecated-var]}
(defmethod align-temporal-unit-with-param-type :default
[_driver _field param-type]
(when (params.dates/date-type? param-type)
:day)) | |
(defmethod align-temporal-unit-with-param-type-and-value :default
[driver field param-type _value]
#_{:clj-kondo/ignore [:deprecated-var]}
(align-temporal-unit-with-param-type driver field param-type)) | |
------------------------------------------- ->replacement-snippet-info ------------------------------------------- | |
(def ^:private ParamSnippetInfo
[:map
[:replacement-snippet {:optional true} :string] ; allowed to be blank if this is an optional param
[:prepared-statement-args {:optional true} [:maybe [:sequential :any]]]]) | |
Return information about how (->replacement-snippet-info :h2 "ABC") -> {:replacement-snippet "?", :prepared-statement-args "ABC"} | (defmulti ->replacement-snippet-info
{:added "0.33.4" :arglists '([driver value])}
(fn [driver v] [(driver/the-initialized-driver driver) (class v)])
:hierarchy #'driver/hierarchy) |
(defn- create-replacement-snippet
[driver nil-or-obj]
(let [{:keys [sql-string param-values]} (->prepared-substitution driver nil-or-obj)]
{:replacement-snippet sql-string
:prepared-statement-args param-values})) | |
(defmethod ->replacement-snippet-info [:sql nil] [driver this] (create-replacement-snippet driver this)) | |
(defmethod ->replacement-snippet-info [:sql Object] [driver this] (create-replacement-snippet driver (str this))) | |
(defmethod ->replacement-snippet-info [:sql Number] [driver this] (create-replacement-snippet driver this)) | |
(defmethod ->replacement-snippet-info [:sql Boolean] [driver this] (create-replacement-snippet driver this)) | |
(defmethod ->replacement-snippet-info [:sql Keyword]
[driver this]
(if (= this params/no-value)
{:replacement-snippet ""}
(create-replacement-snippet driver this))) | |
(defmethod ->replacement-snippet-info [:sql UUID]
[_driver this]
{:replacement-snippet (format "CAST('%s' AS uuid)" (str this))}) | |
(defmethod ->replacement-snippet-info [:sql IPersistentVector]
[driver values]
(let [values (map (partial ->replacement-snippet-info driver) values)]
{:replacement-snippet (str/join ", " (map :replacement-snippet values))
:prepared-statement-args (apply concat (map :prepared-statement-args values))})) | |
(defn- maybe-parse-temporal-literal [x]
(condp instance? x
String (u.date/parse x (qp.timezone/report-timezone-id-if-supported))
Temporal x
(throw (ex-info (tru "Don''t know how to parse {0} {1} as a temporal literal" (class x) (pr-str x))
{:type qp.error-type/invalid-parameter
:parameter x})))) | |
(defmethod ->replacement-snippet-info [:sql Date]
[driver {:keys [s]}]
(create-replacement-snippet driver (maybe-parse-temporal-literal s))) | |
(defn- prepared-ts-subs [driver operator date-str]
(let [{:keys [sql-string param-values]} (->prepared-substitution driver (maybe-parse-temporal-literal date-str))]
{:replacement-snippet (str operator " " sql-string)
:prepared-statement-args param-values})) | |
(defmethod ->replacement-snippet-info [:sql DateRange]
[driver {:keys [start end]}]
(cond
(= start end)
(prepared-ts-subs driver \= start)
(nil? start)
(prepared-ts-subs driver \< end)
(nil? end)
(prepared-ts-subs driver \> start)
:else
;; TIMEZONE FIXME - this is WRONG WRONG WRONG because date ranges should be inclusive for start and *exclusive*
;; for end
(let [[start end] (map (fn [s]
(->prepared-substitution driver (maybe-parse-temporal-literal s)))
[start end])]
{:replacement-snippet (format "BETWEEN %s AND %s" (:sql-string start) (:sql-string end))
:prepared-statement-args (concat (:param-values start) (:param-values end))}))) | |
------------------------------------- Field Filter replacement snippet info -------------------------------------- | |
(mu/defn ^:private combine-replacement-snippet-maps :- ParamSnippetInfo
"Combine multiple `replacement-snippet-maps` into a single map using a SQL `AND` clause."
[replacement-snippet-maps :- [:maybe [:sequential ParamSnippetInfo]]]
{:replacement-snippet (str \( (str/join " AND " (map :replacement-snippet replacement-snippet-maps)) \))
:prepared-statement-args (mapcat :prepared-statement-args replacement-snippet-maps)}) | |
for relative dates convert the param to a | (mu/defn ^:private date-range-field-filter->replacement-snippet-info :- ParamSnippetInfo
[driver value]
(->> (params.dates/date-string->range value)
params/map->DateRange
(->replacement-snippet-info driver))) |
(mu/defn ^:private field-filter->equals-clause-sql :- ParamSnippetInfo
[driver value]
(-> (->replacement-snippet-info driver value)
(update :replacement-snippet (partial str "= ")))) | |
(mu/defn ^:private field-filter-multiple-values->in-clause-sql :- ParamSnippetInfo
[driver values]
(-> (->replacement-snippet-info driver (vec values))
(update :replacement-snippet (partial format "IN (%s)")))) | |
(mu/defn ^:private honeysql->replacement-snippet-info :- ParamSnippetInfo
"Convert `hsql-form` to a replacement snippet info map by passing it to HoneySQL's `format` function."
[driver hsql-form]
(let [[snippet & args] (sql.qp/format-honeysql driver hsql-form)]
{:replacement-snippet snippet
:prepared-statement-args args})) | |
(mu/defn ^:private field->clause :- mbql.s/field
[driver :- :keyword
field :- lib.metadata/ColumnMetadata
param-type :- ::mbql.s/ParameterType
value]
;; The [[metabase.query-processor.middleware.parameters/substitute-parameters]] QP middleware actually happens before
;; the [[metabase.query-processor.middleware.resolve-fields/resolve-fields]] middleware that would normally fetch all
;; the Fields we need in a single pass, so this is actually necessary here. I don't think switching the order of the
;; middleware would work either because we don't know what Field this parameter actually refers to until we resolve
;; the parameter. There's probably _some_ way to structure things that would make this "duplicate" call unneeded, but
;; I haven't figured out what that is yet
[:field
(u/the-id field)
{:base-type (:base-type field)
:temporal-unit (align-temporal-unit-with-param-type-and-value driver field param-type value)
::add/source-table (:table-id field)
;; in case anyone needs to know we're compiling a Field filter.
::compiling-field-filter? true}]) | |
(mu/defn ^:private field->identifier :- ::lib.schema.common/non-blank-string
"Return an approprate snippet to represent this `field` in SQL given its param type.
For non-date Fields, this is just a quoted identifier; for dates, the SQL includes appropriately bucketing based on
the `param-type`."
[driver field param-type value]
(->> (field->clause driver field param-type value)
(sql.qp/->honeysql driver)
(honeysql->replacement-snippet-info driver)
:replacement-snippet)) | |
(mu/defn ^:private field-filter->replacement-snippet-info :- ParamSnippetInfo
"Return `[replacement-snippet & prepared-statement-args]` appropriate for a field filter parameter."
[driver {{param-type :type, value :value, :as params} :value, field :field, :as _field-filter}]
(assert (:id field) (format "Why doesn't Field have an ID?\n%s" (u/pprint-to-str field)))
(letfn [(prepend-field [x]
(update x :replacement-snippet
(partial str (field->identifier driver field param-type value) " ")))
(->honeysql [form]
(sql.qp/->honeysql driver form))]
(cond
(params.ops/operator? param-type)
(->> (assoc params :target [:template-tag (field->clause driver field param-type value)])
params.ops/to-clause
mbql.u/desugar-filter-clause
qp.wrap-value-literals/wrap-value-literals-in-mbql
->honeysql
(honeysql->replacement-snippet-info driver))
(and (params.dates/date-type? param-type)
(string? value)
(re-matches params.dates/date-exclude-regex value))
(let [field-clause (field->clause driver field param-type value)]
(->> (params.dates/date-string->filter value field-clause)
mbql.u/desugar-filter-clause
qp.wrap-value-literals/wrap-value-literals-in-mbql
->honeysql
(honeysql->replacement-snippet-info driver)))
;; convert other date to DateRange record types
(params.dates/not-single-date-type? param-type) (prepend-field
(date-range-field-filter->replacement-snippet-info driver value))
;; convert all other dates to `= <date>`
(params.dates/date-type? param-type) (prepend-field
(field-filter->equals-clause-sql driver (params/map->Date {:s value})))
;; for sequences of multiple values we want to generate an `IN (...)` clause
(sequential? value) (prepend-field
(field-filter-multiple-values->in-clause-sql driver value))
;; convert everything else to `= <value>`
:else (prepend-field
(field-filter->equals-clause-sql driver value))))) | |
(mu/defmethod ->replacement-snippet-info [:sql FieldFilter]
[driver :- :keyword
{:keys [value], :as field-filter} :- [:map
[:field lib.metadata/ColumnMetadata]
[:value :any]]]
(cond
;; otherwise if the value isn't present just put in something that will always be true, such as `1` (e.g. `WHERE 1
;; = 1`). This is only used for field filters outside of optional clauses
(= value params/no-value) {:replacement-snippet "1 = 1"}
;; if we have a vector of multiple values recursively convert them to SQL and combine into an `AND` clause
;; (This is multiple values in the sense that the frontend provided multiple maps with value values for the same
;; FieldFilter, not in the sense that we have a single map with multiple values for `:value`.)
(sequential? value)
(combine-replacement-snippet-maps (for [v value]
(->replacement-snippet-info driver (assoc field-filter :value v))))
;; otherwise convert single value to SQL.
:else
(field-filter->replacement-snippet-info driver field-filter))) | |
------------------------------------ Referenced Card replacement snippet info ------------------------------------ | |
(defmethod ->replacement-snippet-info [:sql ReferencedCardQuery]
[_ {:keys [query params]}]
{:prepared-statement-args (not-empty params)
:replacement-snippet (sql.qp/make-nestable-sql query)}) | |
---------------------------------- Native Query Snippet replacement snippet info --------------------------------- | |
(defmethod ->replacement-snippet-info [:sql ReferencedQuerySnippet]
[_ {:keys [content]}]
{:prepared-statement-args nil
:replacement-snippet content}) | |
The Query Processor is responsible for translating the Metabase Query Language into HoneySQL SQL forms. | (ns metabase.driver.sql.query-processor
(:require
[clojure.core.match :refer [match]]
[clojure.string :as str]
[honey.sql :as sql]
[honey.sql.helpers :as sql.helpers]
[metabase.driver :as driver]
[metabase.driver.common :as driver.common]
[metabase.driver.sql.query-processor.deprecated :as sql.qp.deprecated]
[metabase.lib.metadata :as lib.metadata]
[metabase.lib.schema.common :as lib.schema.common]
[metabase.mbql.schema :as mbql.s]
[metabase.mbql.util :as mbql.u]
[metabase.query-processor.error-type :as qp.error-type]
[metabase.query-processor.middleware.annotate :as annotate]
[metabase.query-processor.middleware.wrap-value-literals
:as qp.wrap-value-literals]
[metabase.query-processor.store :as qp.store]
[metabase.query-processor.util.add-alias-info :as add]
[metabase.query-processor.util.nest-query :as nest-query]
[metabase.util :as u]
[metabase.util.honey-sql-2 :as h2x]
[metabase.util.i18n :refer [deferred-tru tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu])) |
(set! *warn-on-reflection* true) | |
Alias to use for source queries, e.g.: SELECT source.* FROM ( SELECT * FROM some_table ) source | (def source-query-alias "source") |
The INNER query currently being processed, for situations where we need to refer back to it. | (def ^:dynamic *inner-query* nil) |
Do best effort edit to the That requires:
This implementation does not handle few cases cases properly. 100% correct comment and semicolon removal would probably require parsing sql string and not just a regular expression replacement. Link to the discussion: https://github.com/metabase/metabase/pull/30677 For the limitations see the [[metabase.driver.sql.query-processor-test/make-nestable-sql-test]] | (defn make-nestable-sql
[sql]
(str "("
(-> sql
(str/replace #";([\s;]*(--.*\n?)*)*$" "")
str/trimr
(as-> trimmed
;; Query could potentially end with a comment.
(if (re-find #"--.*$" trimmed)
(str trimmed "\n")
trimmed)))
")")) |
(defn- format-sql-source-query [_fn [sql params]] (into [(make-nestable-sql sql)] params)) | |
(sql/register-fn! ::sql-source-query #'format-sql-source-query) | |
Wrap clause in | (defn sql-source-query
[sql params]
(when-not (string? sql)
(throw (ex-info (tru "Expected native source query to be a string, got: {0}"
(.getCanonicalName (class sql)))
{:type qp.error-type/invalid-query
:query sql})))
(when-not ((some-fn nil? sequential?) params)
(throw (ex-info (tru "Expected native source query parameters to be sequential, got: {0}"
(.getCanonicalName (class params)))
{:type qp.error-type/invalid-query
:query params})))
[::sql-source-query sql params]) |
+----------------------------------------------------------------------------------------------------------------+ | Interface (Multimethods) | +----------------------------------------------------------------------------------------------------------------+ | |
DEPRECATED: Prior to between 0.46.0 and 0.49.0, drivers could use either Honey SQL 1 or Honey SQL 2. In 0.49.0+, all drivers must use Honey SQL 2. | (defmulti honey-sql-version
{:arglists '(^Long [driver]), :added "0.46.0", :deprecated "0.49.0"}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Wrap number | (defn inline-num
{:added "0.46.0"}
[n]
{:pre [(number? n)]}
[:inline n]) |
Is | (defn inline?
{:added "0.46.0"}
[honeysql-expr]
(and (vector? honeysql-expr)
(= (first honeysql-expr) :inline))) |
this is the primary way to override behavior for a specific clause or object class. | |
Cast to integer | (defmulti ->integer
{:changelog-test/ignore true :added "0.45.0" :arglists '([driver honeysql-expr])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(defmethod ->integer :sql [_ value] (h2x/->integer value)) | |
Cast to float. | (defmulti ->float
{:changelog-test/ignore true :added "0.45.0" :arglists '([driver honeysql-expr])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(defmethod ->float :sql
[driver value]
;; optimization: we don't need to cast a number literal that is already a `Float` or a `Double` to `FLOAT`. Other
;; number literals can be converted to doubles in Clojure-land. Note that there is a little bit of a mismatch between
;; FLOAT and DOUBLE here, but that's mostly because I'm not 100% sure which drivers have both types. In the future
;; maybe we can fix this.
(cond
(float? value)
(h2x/with-database-type-info (inline-num value) "float")
(number? value)
(recur driver (double value))
(inline? value)
(recur driver (second value))
:else
(h2x/cast :float value))) | |
Return an appropriate HoneySQL form for an object. Dispatches off both driver and either clause name or object class making this easy to override in any places needed for a given driver. | (defmulti ->honeysql
{:added "0.37.0" :arglists '([driver mbql-expr-or-object])}
(fn [driver x]
[(driver/dispatch-on-initialized-driver driver) (mbql.u/dispatch-by-clause-name-or-class x)])
:hierarchy #'driver/hierarchy) |
Wraps a | (defn compiled
{:added "0.46.0"}
[honeysql-expr]
[::compiled honeysql-expr]) |
(defmethod ->honeysql [:sql ::compiled] [_driver [_compiled honeysql-expr :as compiled-form]] ;; preserve metadata attached to the compiled form (with-meta honeysql-expr (meta compiled-form))) | |
(defn- format-compiled
[_compiled [honeysql-expr]]
(sql/format-expr honeysql-expr {:nested true})) | |
(sql/register-fn! ::compiled #'format-compiled) | |
HoneySQL form that should be used to get the current | (defmulti current-datetime-honeysql-form
{:added "0.34.2" :arglists '([driver])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(defmethod current-datetime-honeysql-form :sql [_driver] :%now) | |
Return a HoneySQL form for truncating a date or timestamp field or value to a given resolution, or extracting a date component.
TODO - rename this to | (defmulti date
{:added "0.32.0" :arglists '([driver unit honeysql-expr])}
(fn [driver unit _] [(driver/dispatch-on-initialized-driver driver) unit])
:hierarchy #'driver/hierarchy) |
default implementation for | (defmethod date [:sql :default] [_ _ expr] expr) |
We have to roll our own to account for arbitrary start of week | |
(defmethod date [:sql :second-of-minute] [_driver _ expr] (h2x/second expr)) (defmethod date [:sql :minute-of-hour] [_driver _ expr] (h2x/minute expr)) (defmethod date [:sql :hour-of-day] [_driver _ expr] (h2x/hour expr)) | |
(defmethod date [:sql :week-of-year] [driver _ expr] ;; Some DBs truncate when doing integer division, therefore force float arithmetics (->honeysql driver [:ceil (compiled (h2x// (date driver :day-of-year (date driver :week expr)) 7.0))])) | |
(defmethod date [:sql :month-of-year] [_driver _ expr] (h2x/month expr)) (defmethod date [:sql :quarter-of-year] [_driver _ expr] (h2x/quarter expr)) (defmethod date [:sql :year-of-era] [_driver _ expr] (h2x/year expr)) (defmethod date [:sql :week-of-year-iso] [_driver _ expr] (h2x/week expr)) | |
Returns a HoneySQL form for calculating the datetime-diff for a given unit.
This method is used by implementations of | (defmulti datetime-diff
{:arglists '([driver unit field-or-value field-or-value]), :added "0.46.0"}
(fn [driver unit _ _] [(driver/dispatch-on-initialized-driver driver) unit])
:hierarchy #'driver/hierarchy) |
Takes a datetime expession, return a HoneySQL form
that calculate how many days from the Jan 1st till the start of A full week is a week that contains 7 days in the same year. Example: Assume start-of-week setting is :monday (days-till-start-of-first-full-week driver '2000-04-05') -> 2 Because '2000-01-01' is Saturday, and 1st full week starts on Monday(2000-01-03) => 2 days | (defn- days-till-start-of-first-full-week
[driver honeysql-expr]
(let [start-of-year (date driver :year honeysql-expr)
day-of-week-of-start-of-year (date driver :day-of-week start-of-year)]
(h2x/- 8 day-of-week-of-start-of-year))) |
Calculate the week of year for The idea for both modes are quite similar:
- 1st Jan is always in the 1st week
- the 2nd weeks start on the first The algorithm:
week-of-year = 1 partial-week + Now, all we need to do is to find | (defn- week-of-year
[driver honeysql-expr mode]
(let [days-till-start-of-first-full-week (binding [driver.common/*start-of-week*
(case mode
:us :sunday
:instance nil)]
(days-till-start-of-first-full-week driver honeysql-expr))
total-full-week-days (h2x/- (date driver :day-of-year honeysql-expr)
days-till-start-of-first-full-week)
total-full-weeks (->honeysql driver [:ceil (compiled (h2x// total-full-week-days 7.0))])]
(->integer driver (h2x/+ 1 total-full-weeks)))) |
ISO8501 consider the first week of the year is the week that contains the 1st Thursday and week starts on Monday. - If 1st Jan is Friday, then 1st Jan is the last week of previous year. - If 1st Jan is Wednesday, then 1st Jan is in the 1st week. | (defmethod date [:sql :week-of-year-iso] [_driver _ honeysql-expr] (h2x/week honeysql-expr)) |
US consider the first week begins on 1st Jan, and 2nd week starts on the 1st Sunday | (defmethod date [:sql :week-of-year-us] [driver _ honeysql-expr] (week-of-year driver honeysql-expr :us)) |
First week begins on 1st Jan, the 2nd week will begins on the 1st [[metabase.public-settings/start-of-week]] | (defmethod date [:sql :week-of-year-instance] [driver _ honeysql-expr] (week-of-year driver honeysql-expr :instance)) |
Return a HoneySQL form that performs represents addition of some temporal interval to the original (add-interval-honeysql-form :my-driver hsql-form 1 :day) -> [:date_add hsql-form 1 (h2x/literal 'day')]
| (defmulti add-interval-honeysql-form
{:added "0.34.2" :arglists '([driver hsql-form amount unit])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Truncate to the day the week starts on.
(truncate-fn expr) => truncated-expr | (mu/defn adjust-start-of-week
[driver :- :keyword
truncate-fn :- [:=> [:cat :any] :any]
expr]
(let [offset (driver.common/start-of-week-offset driver)]
(if (not= offset 0)
(add-interval-honeysql-form driver
(truncate-fn (add-interval-honeysql-form driver expr offset :day))
(- offset) :day)
(truncate-fn expr)))) |
Adjust day of week to respect the [[metabase.public-settings/start-of-week]] Setting. The value a
This assumes | (mu/defn adjust-day-of-week
([driver day-of-week-honeysql-expr]
(adjust-day-of-week driver day-of-week-honeysql-expr (driver.common/start-of-week-offset driver)))
([driver day-of-week-honeysql-expr offset]
(adjust-day-of-week driver day-of-week-honeysql-expr offset h2x/mod))
([driver
day-of-week-honeysql-expr
offset :- :int
mod-fn :- [:=> [:cat any? any?] any?]]
(cond
(inline? offset) (recur driver day-of-week-honeysql-expr (second offset) mod-fn)
(zero? offset) day-of-week-honeysql-expr
(neg? offset) (recur driver day-of-week-honeysql-expr (+ offset 7) mod-fn)
:else [:case
[:=
(mod-fn (h2x/+ day-of-week-honeysql-expr offset) (inline-num 7))
(inline-num 0)]
(inline-num 7)
:else
(mod-fn
(h2x/+ day-of-week-honeysql-expr offset)
(inline-num 7))]))) |
Return the dialect that should be used by Honey SQL 2 when building a SQL statement. Defaults to (honey.sql/format ... :quoting (quote-style driver), :allow-dashed-names? true) (The name of this method reflects Honey SQL 1 terminology, where "dialect" was called "quote style". To avoid needless churn, I haven't changed it yet. -- Cam) | (defmulti quote-style
{:added "0.32.0" :arglists '([driver])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(defmethod quote-style :sql [_] :ansi) | |
Return a HoneySQL form appropriate for converting a Unix timestamp integer field or value to an proper SQL Timestamp.
There is a default implementation for | (defmulti unix-timestamp->honeysql
{:arglists '([driver seconds-or-milliseconds honeysql-expr]), :added "0.35.0"}
(fn [driver seconds-or-milliseconds _] [(driver/dispatch-on-initialized-driver driver) seconds-or-milliseconds])
:hierarchy #'driver/hierarchy) |
Cast a string representing | (defmulti cast-temporal-string
{:arglists '([driver coercion-strategy honeysql-expr]), :added "0.38.0"}
(fn [driver coercion-strategy _] [(driver/dispatch-on-initialized-driver driver) coercion-strategy])
:hierarchy #'driver/hierarchy) |
(defmethod cast-temporal-string :default
[driver coercion-strategy _expr]
(throw (ex-info (tru "Driver {0} does not support {1}" driver coercion-strategy)
{:type qp.error-type/unsupported-feature
:coercion-strategy coercion-strategy}))) | |
(defmethod unix-timestamp->honeysql [:sql :milliseconds] [driver _ expr] (unix-timestamp->honeysql driver :seconds (h2x// expr 1000))) | |
(defmethod unix-timestamp->honeysql [:sql :microseconds] [driver _ expr] (unix-timestamp->honeysql driver :seconds (h2x// expr 1000000))) | |
(defmethod unix-timestamp->honeysql [:sql :nanoseconds] [driver _ expr] (unix-timestamp->honeysql driver :seconds (h2x// expr 1000000000))) | |
Cast a byte field | (defmulti cast-temporal-byte
{:arglists '([driver coercion-strategy expr]), :added "0.38.0"}
(fn [driver coercion-strategy _] [(driver/dispatch-on-initialized-driver driver) coercion-strategy])
:hierarchy #'driver/hierarchy) |
(defmethod cast-temporal-byte :default
[driver coercion-strategy _expr]
(throw (ex-info (tru "Driver {0} does not support {1}" driver coercion-strategy)
{:type qp.error-type/unsupported-feature}))) | |
Implementations of this methods define how the SQL Query Processor handles various top-level MBQL clauses. Each
method is called when a matching clause is present in | (defmulti apply-top-level-clause
{:added "0.32.0", :arglists '([driver top-level-clause honeysql-form query]), :style/indent 2}
(fn [driver top-level-clause _ _]
[(driver/dispatch-on-initialized-driver driver) top-level-clause])
:hierarchy #'driver/hierarchy) |
(defmethod apply-top-level-clause :default [_ _ honeysql-form _] honeysql-form) | |
Reaches into a JSON field (that is, a field with a defined Lots of SQL DB's have denormalized JSON fields and they all have some sort of special syntax for dealing with indexing into it. Implement the special syntax in this multimethod. | (defmulti json-query
{:changelog-test/ignore true, :arglists '([driver identifier json-field]), :added "0.43.1"}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
+----------------------------------------------------------------------------------------------------------------+ | Low-Level ->honeysql impls | +----------------------------------------------------------------------------------------------------------------+ | |
[[->honeysql]] shouldn't be getting called on something that is already Honey SQL. Prior to 46/Honey SQL 2, this
would not usually cause problems because we could easily distinguish between MBQL clauses and Honey SQL record
types; with Honey SQL 2, clauses are basically indistinguishable from MBQL, and some things exist in both, like The exception to this rule is [[h2x/identifier]] -- for historical reasons, drivers were encouraged to do this in
the past and some rely on this behavior (see ;;; [[metabase.driver.bigquery-cloud-sdk.query-processor]]
and [[metabase.driver.snowflake]] for example). Maybe we come up with some better way to handle this -- e.g. maybe
[[h2x/identifier]] should be replaced with a If you see this warning, it usually means you are passing a Honey SQL form to a method that expects an MBQL form, usually [[->honeysql]]; this probably means you're recursively calling [[->honeysql]] when you should not be. You can use [[compiled]] to prevent this error, to work around situations where you need to compile something to Honey SQL and then pass it to a method that expects MBQL. This should be considered an icky HACK and you should only do this if you cannot actually fix your code. | (defn- throw-double-compilation-error
[driver x]
;; not i18n'ed because this is meant to be developer-facing.
(throw
(ex-info (format "%s called on something already compiled to Honey SQL. See %s for more info."
`->honeysql
`throw-double-compilation-error)
{:driver driver
:expr x
:type qp.error-type/driver}))) |
(defmethod ->honeysql :default
[driver x]
(when (and (vector? x)
(keyword? (first x)))
(throw-double-compilation-error driver x))
;; user-facing only so it doesn't need to be i18n'ed
(throw (ex-info (format "Don't know how to compile %s to Honey SQL: implement %s for %s"
(pr-str x)
`->honeysql
(pr-str [driver (mbql.u/dispatch-by-clause-name-or-class x)]))
{:driver driver
:expr x
:type qp.error-type/driver}))) | |
(defmethod ->honeysql [:sql nil] [_driver _this] nil) | |
(defmethod ->honeysql [:sql Object] [_driver this] this) | |
(defmethod ->honeysql [:sql Number] [_driver n] (inline-num n)) | |
(defmethod ->honeysql [:sql :value] [driver [_ value]] (->honeysql driver value)) | |
(defmethod ->honeysql [:sql :expression]
[driver [_ expression-name {::add/keys [source-table source-alias]} :as _clause]]
(let [expression-definition (mbql.u/expression-with-name *inner-query* expression-name)]
(->honeysql driver (if (= source-table ::add/source)
(apply h2x/identifier :field source-query-alias source-alias)
expression-definition)))) | |
(defmethod ->honeysql [:sql :now] [driver _clause] (current-datetime-honeysql-form driver)) | |
Translates coercion types like | (defn semantic-type->unix-timestamp-unit
[coercion-type]
(when-not (isa? coercion-type :Coercion/UNIXTime->Temporal)
(throw (ex-info "Semantic type must be a UNIXTimestamp"
{:type qp.error-type/invalid-query
:coercion-type coercion-type})))
(or (get {:Coercion/UNIXNanoSeconds->DateTime :nanoseconds
:Coercion/UNIXMicroSeconds->DateTime :microseconds
:Coercion/UNIXMilliSeconds->DateTime :milliseconds
:Coercion/UNIXSeconds->DateTime :seconds}
coercion-type)
(throw (Exception. (tru "No magnitude known for {0}" coercion-type))))) |
Wrap a | (defn cast-field-if-needed
[driver {:keys [base-type coercion-strategy], :as field} honeysql-form]
(if (some #(str/includes? (name %) "_") (keys field))
(do
(sql.qp.deprecated/log-deprecation-warning
driver
"metabase.driver.sql.query-processor/cast-field-id-needed with a legacy (snake_cased) :model/Field"
"0.48.0")
(recur driver (update-keys field u/->kebab-case-en) honeysql-form))
(u/prog1 (match [base-type coercion-strategy]
[(:isa? :type/Number) (:isa? :Coercion/UNIXTime->Temporal)]
(unix-timestamp->honeysql driver
(semantic-type->unix-timestamp-unit coercion-strategy)
honeysql-form)
[:type/Text (:isa? :Coercion/String->Temporal)]
(cast-temporal-string driver coercion-strategy honeysql-form)
[(:isa? :type/*) (:isa? :Coercion/Bytes->Temporal)]
(cast-temporal-byte driver coercion-strategy honeysql-form)
:else honeysql-form)
(when-not (= <> honeysql-form)
(log/tracef "Applied casting\n=>\n%s" (u/pprint-to-str <>)))))) |
it's a little weird that we're calling [[->honeysql]] on an identifier, which is a Honey SQL form and not an MBQL form. See [[throw-double-compilation-error]] for more info. | (defmethod ->honeysql [:sql ::h2x/identifier] [_driver identifier] identifier) |
Apply temporal bucketing for the | (defn apply-temporal-bucketing
[driver {:keys [temporal-unit]} honeysql-form]
(date driver temporal-unit honeysql-form)) |
Apply | (defn apply-binning
[{{:keys [bin-width min-value _max-value]} :binning} honeysql-form]
;;
;; Equation is | (value - min) |
;; | ------------- | * bin-width + min-value
;; |_ bin-width _|
;;
(cond-> honeysql-form
(not (zero? min-value)) (h2x/- min-value)
true (h2x// bin-width)
true h2x/floor
true (h2x/* bin-width)
(not (zero? min-value)) (h2x/+ min-value))) |
(mu/defn ^:private field-source-table-aliases :- [:maybe [:sequential ::lib.schema.common/non-blank-string]]
"Get sequence of alias that should be used to qualify a `:field` clause when compiling (e.g. left-hand side of an
`AS`).
(field-source-table-aliases [:field 1 nil]) ; -> [\"public\" \"venues\"]"
[[_ id-or-name {::add/keys [source-table]}]]
(let [source-table (or source-table
(when (integer? id-or-name)
(:table-id (lib.metadata/field (qp.store/metadata-provider) id-or-name))))]
(cond
(= source-table ::add/source) [source-query-alias]
(= source-table ::add/none) nil
(integer? source-table) (let [{schema :schema, table-name :name} (lib.metadata/table
(qp.store/metadata-provider)
source-table)]
(not-empty (filterv some? [schema table-name])))
source-table [source-table]))) | |
Get alias that should be use to refer to a (field-source-alias [:field 1 nil]) ; -> "price" | (defn- field-source-alias
[[_field id-or-name {::add/keys [source-alias]}]]
(or source-alias
(when (string? id-or-name)
id-or-name)
(when (integer? id-or-name)
(:name (lib.metadata/field (qp.store/metadata-provider) id-or-name))))) |
(defmethod ->honeysql [:sql :field]
[driver [_ id-or-name {:keys [database-type] :as options}
:as field-clause]]
(try
(let [source-table-aliases (field-source-table-aliases field-clause)
source-alias (field-source-alias field-clause)
field (when (integer? id-or-name)
(lib.metadata/field (qp.store/metadata-provider) id-or-name))
allow-casting? (and field
(not (:qp/ignore-coercion options)))
database-type (or database-type
(:database-type field))
;; preserve metadata attached to the original field clause, for example BigQuery temporal type information.
identifier (-> (apply h2x/identifier :field
(concat source-table-aliases [source-alias]))
(with-meta (meta field-clause)))
identifier (->honeysql driver identifier)
maybe-add-db-type (fn [expr]
(if (h2x/type-info->db-type (h2x/type-info expr))
expr
(h2x/with-database-type-info expr database-type)))]
(u/prog1
(cond->> identifier
allow-casting? (cast-field-if-needed driver field)
;; only add type info if it wasn't added by [[cast-field-if-needed]]
database-type maybe-add-db-type
(:temporal-unit options) (apply-temporal-bucketing driver options)
(:binning options) (apply-binning options))
(log/trace (binding [*print-meta* true]
(format "Compiled field clause\n%s\n=>\n%s"
(u/pprint-to-str field-clause) (u/pprint-to-str <>))))))
(catch Throwable e
(throw (ex-info (tru "Error compiling :field clause: {0}" (ex-message e))
{:clause field-clause}
e))))) | |
(defmethod ->honeysql [:sql :count]
[driver [_ field]]
(if field
[:count (->honeysql driver field)]
:%count.*)) | |
(defmethod ->honeysql [:sql :avg] [driver [_ field]] [:avg (->honeysql driver field)]) (defmethod ->honeysql [:sql :median] [driver [_ field]] [:median (->honeysql driver field)]) (defmethod ->honeysql [:sql :stddev] [driver [_ field]] [:stddev_pop (->honeysql driver field)]) (defmethod ->honeysql [:sql :var] [driver [_ field]] [:var_pop (->honeysql driver field)]) (defmethod ->honeysql [:sql :sum] [driver [_ field]] [:sum (->honeysql driver field)]) (defmethod ->honeysql [:sql :min] [driver [_ field]] [:min (->honeysql driver field)]) (defmethod ->honeysql [:sql :max] [driver [_ field]] [:max (->honeysql driver field)]) | |
(defmethod ->honeysql [:sql :percentile]
[driver [_ field p]]
(let [field (->honeysql driver field)
p (->honeysql driver p)]
[::h2x/percentile-cont field p])) | |
(defmethod ->honeysql [:sql :distinct]
[driver [_ field]]
(let [field (->honeysql driver field)]
[::h2x/distinct-count field])) | |
(defmethod ->honeysql [:sql :floor] [driver [_ mbql-expr]] [:floor (->honeysql driver mbql-expr)]) (defmethod ->honeysql [:sql :ceil] [driver [_ mbql-expr]] [:ceil (->honeysql driver mbql-expr)]) (defmethod ->honeysql [:sql :round] [driver [_ mbql-expr]] [:round (->honeysql driver mbql-expr)]) (defmethod ->honeysql [:sql :abs] [driver [_ mbql-expr]] [:abs (->honeysql driver mbql-expr)]) (defmethod ->honeysql [:sql :log] [driver [_ mbql-expr]] [:log (inline-num 10) (->honeysql driver mbql-expr)]) (defmethod ->honeysql [:sql :exp] [driver [_ mbql-expr]] [:exp (->honeysql driver mbql-expr)]) (defmethod ->honeysql [:sql :sqrt] [driver [_ mbql-expr]] [:sqrt (->honeysql driver mbql-expr)]) | |
(defmethod ->honeysql [:sql :power] [driver [_power mbql-expr power]] [:power (->honeysql driver mbql-expr) (->honeysql driver power)]) | |
(defn- interval? [expr] (mbql.u/is-clause? :interval expr)) | |
(defmethod ->honeysql [:sql :+]
[driver [_ & args]]
(if (some interval? args)
(if-let [[field intervals] (u/pick-first (complement interval?) args)]
(reduce (fn [hsql-form [_ amount unit]]
(add-interval-honeysql-form driver hsql-form amount unit))
(->honeysql driver field)
intervals)
(throw (ex-info "Summing intervals is not supported" {:args args})))
(into [:+]
(map (partial ->honeysql driver))
args))) | |
(defmethod ->honeysql [:sql :-]
[driver [_ & [first-arg & other-args :as args]]]
(cond (interval? first-arg)
(throw (ex-info (tru "Interval as first argrument to subtraction is not allowed.")
{:type qp.error-type/invalid-query
:args args}))
(and (some interval? other-args)
(not (every? interval? other-args)))
(throw (ex-info (tru "All but first argument to subtraction must be an interval.")
{:type qp.error-type/invalid-query
:args args})))
(if (interval? (first other-args))
(reduce (fn [hsql-form [_ amount unit]]
;; We are adding negative amount. Inspired by `->honeysql [:sql :datetime-subtract]`.
(add-interval-honeysql-form driver hsql-form (- amount) unit))
(->honeysql driver first-arg)
other-args)
(into [:-]
(map (partial ->honeysql driver))
args))) | |
(defmethod ->honeysql [:sql :*]
[driver [_ & args]]
(into [:*]
(map (partial ->honeysql driver))
args)) | |
for division we want to go ahead and convert any integer args to floats, because something like field / 2 will do integer division and give us something like 1.0 where we would rather see something like 1.5 also, we want to gracefully handle situations where the column is ZERO and just swap it out with NULL instead, so we don't get divide by zero errors. SQL DBs always return NULL when dividing by NULL (AFAIK) | |
Make sure we're not trying to divide by zero. | (defn- safe-denominator
[denominator]
(cond
;; try not to generate hairy nonsense like `CASE WHERE 7.0 = 0 THEN NULL ELSE 7.0` if we're dealing with number
;; literals and can determine this stuff ahead of time.
(and (number? denominator)
(zero? denominator))
nil
(number? denominator)
(inline-num denominator)
(inline? denominator)
(recur (second denominator))
:else
[:case
[:= denominator (inline-num 0)] nil
:else denominator])) |
(defmethod ->honeysql [:sql :/]
[driver [_ & mbql-exprs]]
(let [[numerator & denominators] (for [mbql-expr mbql-exprs]
(->honeysql driver (if (integer? mbql-expr)
(double mbql-expr)
mbql-expr)))]
(into [:/ (->float driver numerator)]
(map safe-denominator)
denominators))) | |
(defmethod ->honeysql [:sql :sum-where]
[driver [_ arg pred]]
[:sum [:case
(->honeysql driver pred) (->honeysql driver arg)
:else [:inline 0.0]]]) | |
(defmethod ->honeysql [:sql :count-where] [driver [_ pred]] (->honeysql driver [:sum-where 1 pred])) | |
(defmethod ->honeysql [:sql :share] [driver [_ pred]] [:/ (->honeysql driver [:count-where pred]) :%count.*]) | |
(defmethod ->honeysql [:sql :trim] [driver [_ arg]] [:trim (->honeysql driver arg)]) | |
(defmethod ->honeysql [:sql :ltrim] [driver [_ arg]] [:ltrim (->honeysql driver arg)]) | |
(defmethod ->honeysql [:sql :rtrim] [driver [_ arg]] [:rtrim (->honeysql driver arg)]) | |
(defmethod ->honeysql [:sql :upper] [driver [_ arg]] [:upper (->honeysql driver arg)]) | |
(defmethod ->honeysql [:sql :lower] [driver [_ arg]] [:lower (->honeysql driver arg)]) | |
(defmethod ->honeysql [:sql :coalesce] [driver [_ & args]] (into [:coalesce] (map (partial ->honeysql driver)) args)) | |
(defmethod ->honeysql [:sql :replace] [driver [_ arg pattern replacement]] [:replace (->honeysql driver arg) (->honeysql driver pattern) (->honeysql driver replacement)]) | |
(defmethod ->honeysql [:sql :concat] [driver [_ & args]] (into [:concat] (map (partial ->honeysql driver)) args)) | |
(defmethod ->honeysql [:sql :substring]
[driver [_ arg start length]]
(if length
[:substring (->honeysql driver arg) (->honeysql driver start) (->honeysql driver length)]
[:substring (->honeysql driver arg) (->honeysql driver start)])) | |
(defmethod ->honeysql [:sql :length] [driver [_ arg]] [:length (->honeysql driver arg)]) | |
(defmethod ->honeysql [:sql :case]
[driver [_ cases options]]
(into [:case]
(comp cat
(map (partial ->honeysql driver)))
(concat cases
(when (some? (:default options))
[[:else (:default options)]])))) | |
actual handling of the name is done in the top-level clause handler for aggregations | (defmethod ->honeysql [:sql :aggregation-options] [driver [_ ag]] (->honeysql driver ag)) |
aggregation REFERENCE e.g. the ["aggregation" 0] fields we allow in order-by | (defmethod ->honeysql [:sql :aggregation]
[driver [_ index]]
(mbql.u/match-one (nth (:aggregation *inner-query*) index)
[:aggregation-options ag (options :guard :name)]
(->honeysql driver (h2x/identifier :field-alias (:name options)))
[:aggregation-options ag _]
#_:clj-kondo/ignore
(recur ag)
;; For some arcane reason we name the results of a distinct aggregation "count", everything else is named the
;; same as the aggregation
:distinct
(->honeysql driver (h2x/identifier :field-alias :count))
#{:+ :- :* :/}
(->honeysql driver &match)
;; for everything else just use the name of the aggregation as an identifer, e.g. `:sum`
;;
;; TODO -- I don't think we will ever actually get to this anymore because everything should have been given a name
;; by [[metabase.query-processor.middleware.pre-alias-aggregations]]
[ag-type & _]
(->honeysql driver (h2x/identifier :field-alias ag-type)))) |
(defmethod ->honeysql [:sql :absolute-datetime] [driver [_ timestamp unit]] (date driver unit (->honeysql driver timestamp))) | |
(defmethod ->honeysql [:sql :time] [driver [_ value unit]] (date driver unit (->honeysql driver value))) | |
(defmethod ->honeysql [:sql :relative-datetime]
[driver [_ amount unit]]
(date driver unit (if (zero? amount)
(current-datetime-honeysql-form driver)
(add-interval-honeysql-form driver (current-datetime-honeysql-form driver) amount unit)))) | |
(defmethod ->honeysql [:sql :temporal-extract] [driver [_ mbql-expr unit]] (date driver unit (->honeysql driver mbql-expr))) | |
(defmethod ->honeysql [:sql :datetime-add] [driver [_ arg amount unit]] (add-interval-honeysql-form driver (->honeysql driver arg) amount unit)) | |
(defmethod ->honeysql [:sql :datetime-subtract] [driver [_ arg amount unit]] (add-interval-honeysql-form driver (->honeysql driver arg) (- amount) unit)) | |
This util function is used by SQL implementations of ->honeysql for the | (defn datetime-diff-check-args
[x y pred]
(doseq [arg [x y]
:let [db-type (h2x/database-type arg)]
:when (and db-type (not (pred db-type)))]
(throw (ex-info (tru "datetimeDiff only allows datetime, timestamp, or date types. Found {0}"
(pr-str db-type))
{:found db-type
:type qp.error-type/invalid-query})))) |
(defmethod ->honeysql [:sql :datetime-diff]
[driver [_ x y unit]]
(let [x (->honeysql driver x)
y (->honeysql driver y)]
(datetime-diff-check-args x y (partial re-find #"(?i)^(timestamp|date)"))
(datetime-diff driver unit x y))) | |
+----------------------------------------------------------------------------------------------------------------+ | Field Aliases (AS Forms) | +----------------------------------------------------------------------------------------------------------------+ | |
TODO -- this name is a bit of a misnomer since it also handles | (mu/defn field-clause->alias :- some?
"Generate HoneySQL for an approriate alias (e.g., for use with SQL `AS`) for a `:field`, `:expression`, or
`:aggregation` clause of any type, or `nil` if the Field should not be aliased. By default uses the
`::add/desired-alias` key in the clause options.
Optional third parameter `unique-name-fn` is no longer used as of 0.42.0."
([driver :- :keyword
[clause-type id-or-name {::add/keys [desired-alias]}] :- vector?]
(let [desired-alias (or desired-alias
;; fallback behavior for anyone using SQL QP functions directly without including the stuff
;; from [[metabase.query-processor.util.add-alias-info]]. We should probably disallow this
;; going forward because it is liable to break
(when (string? id-or-name)
id-or-name)
(when (and (= clause-type :field)
(integer? id-or-name))
(:name (lib.metadata/field (qp.store/metadata-provider) id-or-name))))]
(->honeysql driver (h2x/identifier :field-alias desired-alias))))
([driver field-clause _unique-name-fn]
(sql.qp.deprecated/log-deprecation-warning
driver
"metabase.driver.sql.query-processor/field-clause->alias with 3 args"
"0.48.0")
(field-clause->alias driver field-clause))) |
Generate HoneySQL for an In some cases where the alias would be redundant, such as plain field literals, this returns the form as-is for
Honey SQL 1. It's wrapped in a vector for Honey SQL 2 to eliminate ambiguity if the clause compiles to a Honey SQL
vector. This is not allowed in Honey SQL 1 -- Honey SQL 2 seems to actually need an additional vector around the ;; Honey SQL 1 (as [:field "x" {:base-type :type/Text}]) ;; -> (Identifier ...) ;; -> SELECT "x" ;; Honey SQL 2 (as [:field "x" {:base-type :type/Text}]) ;; -> [[::h2x/identifier ...]] ;; -> SELECT "x" ;; Honey SQL 1 (as [:field "x" {:base-type :type/Text, :temporal-unit :month}]) ;; -> [(Identifier ...) (Identifier ...)] ;; -> SELECT date_extract("x", 'month') AS "x" ;; Honey SQL 2 (as [:field "x" {:base-type :type/Text, :temporal-unit :month}]) ;; -> [[::h2x/identifier ...] [[::h2x/identifier ...]]] ;; -> SELECT date_extract("x", 'month') AS "x" | (defn as
[driver clause & _unique-name-fn]
(let [honeysql-form (->honeysql driver clause)
field-alias (field-clause->alias driver clause)]
(if field-alias
[honeysql-form [field-alias]]
[honeysql-form]))) |
Certain SQL drivers require that we refer to Fields using the alias we give in the See #17536 and #18742 | |
Rewrite | (defn rewrite-fields-to-force-using-column-aliases
([form]
(rewrite-fields-to-force-using-column-aliases form {:is-breakout false}))
([form {is-breakout :is-breakout}]
(mbql.u/replace form
[:field id-or-name opts]
[:field id-or-name (cond-> opts
true
(assoc ::add/source-alias (::add/desired-alias opts)
::add/source-table ::add/none
;; this key will tell the SQL QP not to apply casting here either.
:qp/ignore-coercion true
;; used to indicate that this is a forced alias
::forced-alias true)
;; don't want to do temporal bucketing or binning inside the order by only.
;; That happens inside the `SELECT`
;; (#22831) however, we do want it in breakout
(not is-breakout)
(dissoc :temporal-unit :binning))]))) |
+----------------------------------------------------------------------------------------------------------------+ | Clause Handlers | +----------------------------------------------------------------------------------------------------------------+ | |
-------------------------------------------------- aggregation --------------------------------------------------- | |
(defmethod apply-top-level-clause [:sql :aggregation]
[driver _top-level-clause honeysql-form {aggregations :aggregation, :as inner-query}]
(let [honeysql-ags (vec (for [ag aggregations
:let [ag-expr (->honeysql driver ag)
ag-name (annotate/aggregation-name inner-query ag)
ag-alias (->honeysql driver (h2x/identifier
:field-alias
(driver/escape-alias driver ag-name)))]]
[ag-expr [ag-alias]]))]
(reduce (if (:select-top honeysql-form)
sql.helpers/select-top
sql.helpers/select)
honeysql-form
honeysql-ags))) | |
----------------------------------------------- breakout & fields ------------------------------------------------ | |
(defmethod apply-top-level-clause [:sql :breakout]
[driver _ honeysql-form {breakout-fields :breakout, fields-fields :fields :as _query}]
(let [select (if (:select-top honeysql-form)
sql.helpers/select-top
sql.helpers/select)]
(as-> honeysql-form new-hsql
(apply select new-hsql (->> breakout-fields
(remove (set fields-fields))
(mapv (fn [field-clause]
(as driver field-clause)))))
(apply sql.helpers/group-by new-hsql (mapv (partial ->honeysql driver) breakout-fields))))) | |
(defmethod apply-top-level-clause [:sql :fields]
[driver _ honeysql-form {fields :fields}]
(apply (if (:select-top honeysql-form)
sql.helpers/select-top
sql.helpers/select)
honeysql-form
(for [field-clause fields]
(as driver field-clause)))) | |
----------------------------------------------------- filter ----------------------------------------------------- | |
Generate honeysql like clause used in | (defn- like-clause
[field pattern {:keys [case-sensitive] :or {case-sensitive true} :as _options}]
;; TODO - don't we need to escape underscores and percent signs in the pattern, since they have special meanings in
;; LIKE clauses? That's what we're doing with Druid... (Cam)
;;
;; TODO - Postgres supports `ILIKE`. Does that make a big enough difference performance-wise that we should do a
;; custom implementation? (Cam)
[:like
(if case-sensitive
field
[:lower field])
pattern]) |
(def ^:private StringValueOrFieldOrExpression
[:or
[:and mbql.s/value
[:fn {:error/message "string value"} #(string? (second %))]]
mbql.s/FieldOrExpressionDef]) | |
Generate pattern to match against in like clause. Lowercasing for case insensitive matching also happens here. | (mu/defn ^:private generate-pattern
[driver
pre
[type _ :as arg] :- StringValueOrFieldOrExpression
post
{:keys [case-sensitive] :or {case-sensitive true} :as _options}]
(if (= :value type)
(->honeysql driver (update arg 1 #(cond-> (str pre % post)
(not case-sensitive) u/lower-case-en)))
(let [expr (->honeysql driver (into [:concat] (remove nil?) [pre arg post]))]
(if case-sensitive
expr
[:lower expr])))) |
(defmethod ->honeysql [:sql :starts-with] [driver [_ field arg options]] (like-clause (->honeysql driver field) (generate-pattern driver nil arg "%" options) options)) | |
(defmethod ->honeysql [:sql :contains] [driver [_ field arg options]] (like-clause (->honeysql driver field) (generate-pattern driver "%" arg "%" options) options)) | |
(defmethod ->honeysql [:sql :ends-with] [driver [_ field arg options]] (like-clause (->honeysql driver field) (generate-pattern driver "%" arg nil options) options)) | |
(defmethod ->honeysql [:sql :between] [driver [_ field min-val max-val]] [:between (->honeysql driver field) (->honeysql driver min-val) (->honeysql driver max-val)]) | |
(defmethod ->honeysql [:sql :>] [driver [_ field value]] [:> (->honeysql driver field) (->honeysql driver value)]) | |
(defmethod ->honeysql [:sql :<] [driver [_ field value]] [:< (->honeysql driver field) (->honeysql driver value)]) | |
(defmethod ->honeysql [:sql :>=] [driver [_ field value]] [:>= (->honeysql driver field) (->honeysql driver value)]) | |
(defmethod ->honeysql [:sql :<=] [driver [_ field value]] [:<= (->honeysql driver field) (->honeysql driver value)]) | |
(defmethod ->honeysql [:sql :=] [driver [_ field value]] (assert field) [:= (->honeysql driver field) (->honeysql driver value)]) | |
(defn- correct-null-behaviour
[driver [op & args :as clause]]
(if-let [field-arg (mbql.u/match-one args
:field &match)]
;; We must not transform the head again else we'll have an infinite loop
;; (and we can't do it at the call-site as then it will be harder to fish out field references)
[:or
(into [op] (map (partial ->honeysql driver)) args)
[:= (->honeysql driver field-arg) nil]]
clause)) | |
(defmethod ->honeysql [:sql :!=]
[driver [_ field value]]
(if (nil? (qp.wrap-value-literals/unwrap-value-literal value))
[:not= (->honeysql driver field) (->honeysql driver value)]
(correct-null-behaviour driver [:not= field value]))) | |
(defmethod ->honeysql [:sql :and]
[driver [_tag & subclauses]]
(into [:and]
(map (partial ->honeysql driver))
subclauses)) | |
(defmethod ->honeysql [:sql :or]
[driver [_tag & subclauses]]
(into [:or]
(map (partial ->honeysql driver))
subclauses)) | |
(def ^:private clause-needs-null-behaviour-correction?
(comp #{:contains :starts-with :ends-with} first)) | |
(defmethod ->honeysql [:sql :not]
[driver [_tag subclause]]
(if (clause-needs-null-behaviour-correction? subclause)
(correct-null-behaviour driver [:not subclause])
[:not (->honeysql driver subclause)])) | |
(defmethod apply-top-level-clause [:sql :filter]
[driver _ honeysql-form {clause :filter}]
(sql.helpers/where honeysql-form (->honeysql driver clause))) | |
-------------------------------------------------- join tables --------------------------------------------------- | |
(declare mbql->honeysql) | |
Compile a single MBQL | (defmulti join->honeysql
{:added "0.32.9" :arglists '([driver join])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Generate HoneySQL for a table or query to be joined. | (defmulti join-source
{:added "0.32.9" :arglists '([driver join])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(defmethod join-source :sql
[driver {:keys [source-table source-query]}]
(cond
(and source-query (:native source-query))
(sql-source-query (:native source-query) (:params source-query))
source-query
(mbql->honeysql driver {:query source-query})
:else
(->honeysql driver (lib.metadata/table (qp.store/metadata-provider) source-table)))) | |
Schema for HoneySQL for a single JOIN. Used to validate that our join-handling code generates correct clauses. | (def ^:private HoneySQLJoin
[:tuple
;;join source and alias
[:tuple
;; join source
:some
;; join alias
:some]
;; join condition
[:sequential :any]]) |
(mu/defmethod join->honeysql :sql :- HoneySQLJoin
[driver {:keys [condition], join-alias :alias, :as join} :- mbql.s/Join]
[[(join-source driver join)
(let [table-alias (->honeysql driver (h2x/identifier :table-alias join-alias))]
[table-alias])]
(->honeysql driver condition)]) | |
Use Honey SQL 2's | (defn- apply-joins-honey-sql-2
[driver honeysql-form joins]
(letfn [(append-joins [join-by]
(into (vec join-by)
(mapcat (fn [{:keys [strategy], :as join}]
[strategy (join->honeysql driver join)]))
joins))]
(update honeysql-form :join-by append-joins))) |
(defmethod apply-top-level-clause [:sql :joins]
[driver _ honeysql-form {:keys [joins]}]
#_{:clj-kondo/ignore [:deprecated-var]}
(let [f apply-joins-honey-sql-2]
(f driver honeysql-form joins))) | |
---------------------------------------------------- order-by ---------------------------------------------------- | |
(defmethod ->honeysql [:sql :asc] [driver [direction field]] [(->honeysql driver field) direction]) | |
(defmethod ->honeysql [:sql :desc] [driver [direction field]] [(->honeysql driver field) direction]) | |
(defmethod apply-top-level-clause [:sql :order-by]
[driver _ honeysql-form {subclauses :order-by}]
(reduce sql.helpers/order-by honeysql-form (mapv (partial ->honeysql driver) subclauses))) | |
-------------------------------------------------- limit & page -------------------------------------------------- | |
(defmethod apply-top-level-clause [:sql :limit]
[_driver _top-level-clause honeysql-form {value :limit}]
(sql.helpers/limit honeysql-form (inline-num value))) | |
(defmethod apply-top-level-clause [:sql :page]
[_driver _top-level-clause honeysql-form {{:keys [items page]} :page}]
(-> honeysql-form
(sql.helpers/limit (inline-num items))
(sql.helpers/offset (inline-num (* items (dec page)))))) | |
-------------------------------------------------- source-table -------------------------------------------------- | |
(defn- has-to-honeysql-impl-for-legacy-table? [driver]
(not (identical? (get-method ->honeysql [driver :model/Table])
(get-method ->honeysql [:sql :model/Table])))) | |
(defmethod ->honeysql [:sql :model/Table]
[driver table]
(sql.qp.deprecated/log-deprecation-warning
driver
"metabase.driver.sql.query-processor/->honeysql for metabase.models.table/Table or :model/Table"
"0.48.0")
(let [{table-name :name, schema :schema} table]
(->honeysql driver (h2x/identifier :table schema table-name)))) | |
(defmethod ->honeysql [:sql :metadata/table]
[driver table]
(if (has-to-honeysql-impl-for-legacy-table? driver)
(do
(sql.qp.deprecated/log-deprecation-warning
driver
"metabase.driver.sql.query-processor/->honeysql for metabase.models.table/Table or :model/Table"
"0.48.0")
(->honeysql driver #_{:clj-kondo/ignore [:deprecated-var]} (qp.store/->legacy-metadata table)))
(let [{table-name :name, schema :schema} table]
(->honeysql driver (h2x/identifier :table schema table-name))))) | |
(defmethod apply-top-level-clause [:sql :source-table]
[driver _top-level-clause honeysql-form {source-table-id :source-table}]
(let [table (lib.metadata/table (qp.store/metadata-provider) source-table-id)
expr (->honeysql driver table)]
(sql.helpers/from honeysql-form [expr]))) | |
+----------------------------------------------------------------------------------------------------------------+ | Building the HoneySQL Form | +----------------------------------------------------------------------------------------------------------------+ | |
Order to apply top-level clauses in. This is important because we build things like the Map of clause -> index, e.g. {:source-table 0, :breakout 1, ...} | (def ^:private top-level-clause-application-order
(into {} (map-indexed
#(vector %2 %1)
[:source-table :breakout :aggregation :fields :filter :joins :order-by :page :limit]))) |
Return the keys present in an MBQL | (defn- query->keys-in-application-order
[inner-query]
;; sort first by any known top-level clauses according to the `top-level-application-clause-order` defined above,
;; then sort any unknown clauses by name.
(sort-by (fn [clause] [(get top-level-clause-application-order clause Integer/MAX_VALUE) clause])
(keys inner-query))) |
(defn- format-honeysql-2 [dialect honeysql-form]
;; throw people a bone and make sure they're not trying to use Honey SQL 1 stuff inside Honey SQL 2.
(mbql.u/match honeysql-form
(form :guard record?)
(throw (ex-info (format "Not supported by Honey SQL 2: ^%s %s"
(.getCanonicalName (class form))
(pr-str form))
{:honeysql-form honeysql-form, :form form})))
(if (map? honeysql-form)
#_{:clj-kondo/ignore [:discouraged-var]}
(sql/format honeysql-form {:dialect dialect, :quoted true, :quoted-snake false})
;; for weird cases when we want to compile just one particular snippet. Why are we doing this? Who knows. This seems
;; to not really be supported by Honey SQL 2, so hack around it for now. See upstream issue
;; https://github.com/seancorfield/honeysql/issues/456
(binding [sql/*dialect* (sql/get-dialect dialect)
sql/*quoted* true
sql/*quoted-snake* false]
(sql/format-expr honeysql-form {:nested true})))) | |
Compile a | (defn format-honeysql
([driver honeysql-form]
(format-honeysql nil (quote-style driver) honeysql-form))
;; TODO -- get rid of this unused param without breaking things.
([_version dialect honeysql-form]
(try
(format-honeysql-2 dialect honeysql-form)
(catch Throwable e
(try
(log/error e
(u/format-color 'red
(str (deferred-tru "Invalid HoneySQL form: {0}" (ex-message e))
"\n"
(u/pprint-to-str honeysql-form))))
(finally
(throw (ex-info (tru "Error compiling HoneySQL form: {0}" (ex-message e))
{:dialect dialect
:form honeysql-form
:type qp.error-type/driver}
e)))))))) |
(defn- default-select [driver {[from] :from, :as _honeysql-form}]
(let [table-identifier (if (sequential? from)
;; Grab the alias part.
;;
;; Honey SQL 2 = [expr [alias]]
(first (second from))
from)
[raw-identifier] (format-honeysql driver table-identifier)
expr (if (seq raw-identifier)
[:raw (format "%s.*" raw-identifier)]
:*)]
[[expr]])) | |
Add | (defn- add-default-select
[driver {:keys [select select-top], :as honeysql-form}]
;; TODO - this is hacky -- we should ideally never need to add `SELECT *`, because we should know what fields to
;; expect from the source query, and middleware should be handling that for us
(cond
(and (empty? select)
(empty? select-top))
(assoc honeysql-form :select (default-select driver honeysql-form))
;; select-top currently only has the first arg, the limit
(= (count select-top) 1)
(update honeysql-form :select-top (fn [existing]
(into existing (default-select driver honeysql-form))))
:else
honeysql-form)) |
| (defn- apply-top-level-clauses
([driver honeysql-form inner-query]
(apply-top-level-clauses driver honeysql-form inner-query identity))
([driver honeysql-form inner-query xform]
(transduce
xform
(fn
([honeysql-form]
(add-default-select driver honeysql-form))
([honeysql-form k]
(apply-top-level-clause driver k honeysql-form inner-query)))
honeysql-form
(query->keys-in-application-order inner-query)))) |
(declare apply-clauses) | |
Handle a | (defn- apply-source-query
[driver honeysql-form {{:keys [native params],
persisted :persisted-info/native
:as source-query} :source-query}]
(assoc honeysql-form
:from [[(cond
persisted
(sql-source-query persisted nil)
native
(sql-source-query native params)
:else
(apply-clauses driver {} source-query))
(let [table-alias (->honeysql driver (h2x/identifier :table-alias source-query-alias))]
[table-alias])]])) |
Like [[apply-top-level-clauses]], but handles | (defn- apply-clauses
[driver honeysql-form {:keys [source-query], :as inner-query}]
(binding [*inner-query* inner-query]
(if source-query
(apply-top-level-clauses
driver
(apply-source-query driver honeysql-form inner-query)
inner-query
;; don't try to do anything with the source query recursively.
(remove (partial = :source-query)))
(apply-top-level-clauses driver honeysql-form inner-query)))) |
Do miscellaneous transformations to the MBQL before compiling the query. These changes are idempotent, so it is safe to use this function in your own implementations of [[driver/mbql->native]], if you want to apply changes to the same version of the query that we will ultimately be compiling. | (defmulti preprocess
{:changelog-test/ignore true, :arglists '([driver inner-query]), :added "0.42.0"}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(defmethod preprocess :sql [_driver inner-query] (nest-query/nest-expressions (add/add-alias-info inner-query))) | |
Build the HoneySQL form we will compile to SQL and execute. | (defn mbql->honeysql
[driver {inner-query :query}]
(binding [driver/*driver* driver]
(let [inner-query (preprocess driver inner-query)]
(log/tracef "Compiling MBQL query\n%s" (u/pprint-to-str 'magenta inner-query))
(u/prog1 (apply-clauses driver {} inner-query)
(log/debugf "\nHoneySQL Form: %s\n%s" (u/emoji "🍯") (u/pprint-to-str 'cyan <>)))))) |
MBQL -> Native | |
Transpile MBQL query into a native SQL statement. This is the | (defn mbql->native
[driver outer-query]
(let [honeysql-form (mbql->honeysql driver outer-query)
[sql & args] (format-honeysql driver honeysql-form)]
{:query sql, :params args})) |
Deprecated stuff that used to live in [[metabase.driver.sql.query-processor]]. Moved here so it can live out its last days in a place we don't have to look at it, and to discourage people from using it. Also convenient for seeing everything that's deprecated at a glance. Deprecated method impls should call [[log-deprecation-warning]] to gently nudge driver authors to stop using this method. | (ns metabase.driver.sql.query-processor.deprecated (:require [metabase.query-processor.store :as qp.store] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log])) |
This is unused at this moment in time but we can leave it around in case we want to use it again in the
future (likely). See the code at | |
Log a warning about usage of a deprecated method. (log-deprecation-warning driver 'my.namespace/method "v0.42.0") TODO -- this is actually pretty handy and I think we ought to use it for all the deprecated driver methods. | (defn log-deprecation-warning
[driver method-name deprecated-version]
(letfn [(thunk []
(log/warn
(u/colorize 'red
(trs "Warning: Driver {0} is using {1}. This method was deprecated in {2} and will be removed in a future release."
driver method-name deprecated-version))))]
;; only log each individual message once for the current QP store; by 'caching' the value with the key it is
;; effectively memoized for the rest of the QP run for the current query. The goal here is to avoid blasting the
;; logs with warnings about deprecated method calls, but still remind people regularly enough that it gets fixed
;; sometime in the near future.
(if (qp.store/initialized?)
(qp.store/cached [driver method-name deprecated-version]
(thunk))
(thunk)))) |
In Oracle and some other databases, empty strings are considered to be Drivers can derive from this abstract driver to use an alternate implementation(s) of SQL QP method(s) that treat
empty strings as | (ns metabase.driver.sql.query-processor.empty-string-is-null (:require [metabase.driver :as driver] [metabase.driver.sql.query-processor :as sql.qp])) |
(driver/register! ::empty-string-is-null, :abstract? true) | |
(defmethod sql.qp/->honeysql [::empty-string-is-null :value]
[driver [_ value info]]
(let [value (when-not (= value "")
value)]
((get-method sql.qp/->honeysql [:sql :value]) driver [:value value info]))) | |
(prefer-method sql.qp/->honeysql [::empty-string-is-null :value] [:sql :value]) | |
(ns metabase.driver.sql.query-processor.util (:require [metabase.util.honey-sql-2 :as h2x])) | |
Take a nested field column field corresponding to something like an inner key within a JSON column, and then get the parent column's identifier from its own identifier and the nfc path stored in the field. Suppose you have the child with corresponding identifier (metabase.util.honey-sql-2/identifier :field "blah -> boop") Ultimately, this is just a way to get the parent identifier (metabase.util.honey-sql-2/identifier :field "blah") | (defn nfc-field->parent-identifier
[field-identifier {:keys [nfc-path], :as _field}]
{:pre [(h2x/identifier? field-identifier)]}
(let [parent-components (-> (last field-identifier)
(vec)
(pop)
(conj (first nfc-path)))]
(apply h2x/identifier (cons :field parent-components)))) |
Utility functions for writing SQL drivers. | (ns metabase.driver.sql.util (:require [clojure.string :as str] [metabase.driver.sql.query-processor :as sql.qp] [metabase.query-processor.error-type :as qp.error-type] [metabase.util :as u] [metabase.util.honey-sql-2 :as h2x] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log] [metabase.util.malli :as mu]) (:import (com.github.vertical_blank.sqlformatter SqlFormatter SqlFormatter$Formatter) (com.github.vertical_blank.sqlformatter.core DialectConfig) (com.github.vertical_blank.sqlformatter.languages Dialect))) |
(set! *warn-on-reflection* true) | |
Quote unqualified string or keyword identifier(s) by passing them to (quote-name :mysql :field "wow") ; -> " You should only use this function for places where you are not using HoneySQL, such as queries written directly in
SQL. For HoneySQL forms, | (mu/defn quote-name
"Quote unqualified string or keyword identifier(s) by passing them to `h2x/identifier`, then calling HoneySQL `format`
on the resulting `Identifier`. Uses the `sql.qp/quote-style` of the current driver. You can implement `->honeysql`
for `Identifier` if you need custom behavior here.
(quote-name :mysql :field \"wow\") ; -> \"`wow`\"
(quote-name :h2 :field \"wow\") ; -> \"\\\"WOW\\\"\"
You should only use this function for places where you are not using HoneySQL, such as queries written directly in
SQL. For HoneySQL forms, `Identifier` is converted to SQL automatically when it is compiled."
[driver :- :keyword
identifier-type :- h2x/IdentifierType
& components]
(first
(sql.qp/format-honeysql driver (apply h2x/identifier identifier-type components)))) |
+----------------------------------------------------------------------------------------------------------------+ | Deduplicate Field Aliases | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn ^:private increment-identifier-string :- :string
[last-component :- :string]
(if-let [[_ existing-suffix] (re-find #"^.*_(\d+$)" last-component)]
;; if last-component already has an alias like col_2 then increment it to col_3
(let [new-suffix (str (inc (Integer/parseInt existing-suffix)))]
(str/replace last-component (re-pattern (str existing-suffix \$)) new-suffix))
;; otherwise just stick a _2 on the end so it's col_2
(str last-component "_2"))) | |
Add an appropriate suffix to a keyword (increment-identifier :mycol) ; -> :mycol_2 (increment-identifier :mycol2) ; -> :mycol3 | (mu/defn ^:private increment-identifier
[[_tag identifier-type components] :- h2x/Identifier]
(let [components' (concat
(butlast components)
[(increment-identifier-string (u/qualified-name (last components)))])]
(apply h2x/identifier identifier-type components'))) |
Make sure all the columns in | (defn select-clause-alias-everything
[select-clause]
(for [col select-clause]
(cond
;; if something's already an alias form like [:table.col :col] it's g2g
(and (sequential? col)
(not (h2x/identifier? col)))
col
;; otherwise we *should* be dealing with an Identifier. If so, take the last component of the Identifier and use
;; that as the alias.
;;
;; TODO - could this be done using `->honeysql` or `field->alias` instead?
(h2x/identifier? col)
(let [[_tag _identifier-type components] col]
[col (h2x/identifier :field-alias (last components))])
:else
(do
(log/errorf "Don't know how to alias %s, expected an h2x/identifier" (pr-str col))
[col col])))) |
Make sure every column in | (defn select-clause-deduplicate-aliases
[select-clause]
(if (= select-clause [:*])
;; if we're doing `SELECT *` there's no way we can deduplicate anything so we're SOL, return as-is
select-clause
;; otherwise we can actually deduplicate things
(loop [already-seen #{}, acc [], [[col alias] & more] (select-clause-alias-everything select-clause)]
(cond
;; if not more cols are left to deduplicate, we're done
(not col)
acc
;; otherwise if we've already used this alias, replace it with one like `identifier_2` and try agan
(contains? already-seen alias)
(recur already-seen acc (cons [col (increment-identifier alias)]
more))
;; otherwise if we haven't seen it record it as seen and move on to the next column
:else
(recur (conj already-seen alias) (conj acc [col alias]) more))))) |
Escape single quotes in a SQL string. (escape-sql "Tito's Tacos" :ansi) ; -> "Tito''s Tacos" (escape-sql "Tito's Tacos" :backslashes) ; -> "Tito\'s Tacos" !!!! VERY IMPORTANT !!!! DON'T RELY ON THIS FOR SANITIZING USER INPUT BEFORE RUNNING QUERIES! For user input, ALWAYS pass parameters separately (e.g. using | (defn escape-sql
"Escape single quotes in a SQL string. `escape-style` is either `:ansi` (escape a single quote with two single quotes)
or `:backslashes` (escape a single quote with a backslash).
(escape-sql \"Tito's Tacos\" :ansi) ; -> \"Tito''s Tacos\"
(escape-sql \"Tito's Tacos\" :backslashes) ; -> \"Tito\\'s Tacos\"
!!!! VERY IMPORTANT !!!!
DON'T RELY ON THIS FOR SANITIZING USER INPUT BEFORE RUNNING QUERIES!
For user input, *ALWAYS* pass parameters separately (e.g. using `?` in the SQL) where supported, or if unsupported,
encode the strings as hex and splice in something along the lines of `utf8_string(hex_decode(<hex-string>))`
instead. This is intended only for escaping trusted strings, or for generating the SQL equivalent version of an MBQL
query for debugging purposes or powering the 'convert to SQL' feature."
{:arglists '([s :ansi] [s :backslashes])}
^String [^String s escape-style]
(when s
(case escape-style
:ansi (str/replace s "'" "''")
:backslashes (-> s
(str/replace "\\" "\\\\")
(str/replace "'" "\\'"))))) |
Validate the arguments of convert-timezone. - if input column has timezone only target-timezone is required, throw exception if source-timezone is provided. - if input column doesn't have a timezone both target-timezone and source-timezone are required. | (defn validate-convert-timezone-args
[has-timezone? target-timezone source-timezone]
(when (and has-timezone? source-timezone)
(throw (ex-info (tru "input column already has a set timezone. Please remove the source parameter in convertTimezone.")
{:type qp.error-type/invalid-query
:target-timezone target-timezone
:source-timezone source-timezone})))
(when (and (not has-timezone?) (not source-timezone))
(throw (ex-info (tru "input column doesn't have a set timezone. Please set the source parameter in convertTimezone to convert it.")
{:type qp.error-type/invalid-query
:target-timezone target-timezone
:source-timezone source-timezone})))) |
[[format-sql]] will expand parameterized values (e.g. {{#123}} -> { { # 123 } }). This function fixes that by removing whitespace from matching double-curly brace substrings. | (defn fix-sql-params
[sql]
(when (string? sql)
(let [rgx #"\{\s*\{\s*[^\}]+\s*\}\s*\}"]
(str/replace sql rgx (fn [match] (str/replace match #"\s*" "")))))) |
Mapping of dialect kw to dialect, used by sql formatter in [[format-sql]], to dialect. | (def dialects
{:db2 Dialect/Db2
:mariadb Dialect/MariaDb
:mysql Dialect/MySql
:n1ql Dialect/N1ql
:plsql Dialect/PlSql
:postgres Dialect/PostgreSql
:redshift Dialect/Redshift
:sparksql Dialect/SparkSql
:standardsql Dialect/StandardSql
:tsql Dialect/TSql}) |
(def ^:private ^java.util.List additional-operators ["#>>" "!="]) | |
(defn- add-operators
^SqlFormatter$Formatter [^SqlFormatter$Formatter formatter]
(.extend formatter (reify java.util.function.UnaryOperator
(apply [_this config]
(.plusOperators ^DialectConfig config additional-operators))))) | |
Pretty format | (defn format-sql
[driver-or-dialect-kw sql]
(when (string? sql)
(let [dialect (get dialects driver-or-dialect-kw Dialect/StandardSql)
formatter (add-operators (SqlFormatter/of ^Dialect dialect))]
(.format formatter ^String sql)))) |
[[format-sql]] and [[fix-sql-params]] afterwards. For details see those functions. | (defn format-sql-and-fix-params [driver-or-dialect-kw sql] (-> (format-sql driver-or-dialect-kw sql) fix-sql-params)) |
Utility functions for converting a prepared statement with TODO -- since this is no longer strictly a 'util' namespace (most | (ns metabase.driver.sql.util.unprepare (:require [clojure.string :as str] [java-time.api :as t] [metabase.driver :as driver] [metabase.driver.sql.util :as sql.u] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log]) (:import (java.time Instant LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime ZonedDateTime))) |
(set! *warn-on-reflection* true) | |
Convert a single argument to appropriate raw SQL for splicing directly into a SQL query. Dispatches on both driver
and the class of | (defmulti unprepare-value
{:added "0.32.0" :arglists '(^String [driver value])}
(fn [driver value]
[(driver/the-initialized-driver driver) (class value)])
:hierarchy #'driver/hierarchy) |
(defmethod unprepare-value :default
[_ value]
;; it's better return a slightly broken SQL query with a probably incorrect string representation of the value than
;; to have the entire QP run fail because of an unknown type.
(log/warn (trs "Don''t know how to unprepare values of class {0}" (.getName (class value))))
(str value)) | |
(defmethod unprepare-value [:sql nil] [_ _] "NULL") | |
(defmethod unprepare-value [:sql String] [_ s] ;; escape single-quotes like Cam's String -> Cam''s String (str \' (sql.u/escape-sql s :ansi) \')) | |
(defmethod unprepare-value [:sql Boolean] [_ value] (if value "TRUE" "FALSE")) | |
(defmethod unprepare-value [:sql Number] [_ value] (str value)) | |
(defmethod unprepare-value [:sql LocalDate] [_ t] (format "date '%s'" (t/format "yyyy-MM-dd" t))) | |
(defmethod unprepare-value [:sql LocalTime] [_ t] (format "time '%s'" (t/format "HH:mm:ss.SSS" t))) | |
(defmethod unprepare-value [:sql OffsetTime] [_ t] (format "time with time zone '%s'" (t/format "HH:mm:ss.SSSZZZZZ" t))) | |
(defmethod unprepare-value [:sql LocalDateTime] [_ t] (format "timestamp '%s'" (t/format "yyyy-MM-dd HH:mm:ss.SSS" t))) | |
(defmethod unprepare-value [:sql OffsetDateTime] [_ t] (format "timestamp with time zone '%s'" (t/format "yyyy-MM-dd HH:mm:ss.SSSZZZZZ" t))) | |
(defmethod unprepare-value [:sql ZonedDateTime] [_ t] (format "timestamp with time zone '%s'" (t/format "yyyy-MM-dd HH:mm:ss.SSSZZZZZ" t))) | |
TODO - pretty sure we can remove this | (defmethod unprepare-value [:sql Instant] [driver t] (unprepare-value driver (t/offset-date-time t (t/zone-offset 0)))) |
Convert a normal SQL Drivers likely do not need to implement this method themselves -- instead, you should only need to provide
implementations of TODO - I think a name like | (defmulti ^String unprepare
{:added "0.32.0", :arglists '([driver [sql & args]]), :style/indent 1}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(defmethod unprepare :sql [driver [sql & args]]
(transduce
identity
(completing
(fn [sql arg]
;; Only match single question marks; do not match ones like `??` which JDBC converts to `?` to use as Postgres
;; JSON operators amongst other things.
;;
;; TODO - this is not smart enough to handle question marks in non argument contexts, for example if someone
;; were to have a question mark inside an identifier such as a table name. I think we'd have to parse the SQL in
;; order to handle those situations.
(let [v (str (unprepare-value driver arg))]
(log/tracef "Splice %s as %s" (pr-str arg) (pr-str v))
(str/replace-first sql #"(?<!\?)\?(?!\?)" (str/re-quote-replacement v))))
(fn [spliced-sql]
(log/tracef "Spliced %s\n-> %s" (u/colorize 'green (pr-str sql)) (u/colorize 'blue (pr-str spliced-sql)))
spliced-sql))
sql
args)) | |
General functions and utilities for sync operations across multiple drivers. | (ns metabase.driver.sync (:require [clojure.string :as str] [metabase.driver.util :as driver.u]) (:import (java.util.regex Pattern))) |
(set! *warn-on-reflection* true) | |
Converts a schema pattern, as entered in the UI, into regex pattern suitable to be passed into [[re-pattern]]. The
conversion that happens is from commas into pipes (disjunction), and wildcard characters ( Examples: a,b => a|b test* => test.* foo,bar => foo.|.bar foo , bar , baz => foo|ba.r|baz crazy*schema => crazy*schema | (defn- schema-pattern->re-pattern
"Converts a schema pattern, as entered in the UI, into regex pattern suitable to be passed into [[re-pattern]]. The
conversion that happens is from commas into pipes (disjunction), and wildcard characters (`*`) into greedy wildcard
matchers (`.*`). These only occur if those characters are not preceded by a backslash, which serves as an escape
character for purposes of this conversion. Any whitespace before and after commas is trimmed.
Examples:
a,b => a|b
test* => test.*
foo*,*bar => foo.*|.*bar
foo , ba*r , baz => foo|ba.*r|baz
crazy\\*schema => crazy\\*schema"
^Pattern [^String schema-pattern]
(re-pattern (->> (str/split schema-pattern #",")
(map (comp #(str/replace % #"(^|[^\\\\])\*" "$1.*") str/trim))
(str/join "|")))) |
(defn- schema-patterns->filter-fn*
[inclusion-patterns exclusion-patterns]
(let [inclusion-blank? (str/blank? inclusion-patterns)
exclusion-blank? (str/blank? exclusion-patterns)]
(cond
(and inclusion-blank? exclusion-blank?)
(constantly true)
(and (not inclusion-blank?) (not exclusion-blank?))
(throw (ex-info "Inclusion and exclusion patterns cannot both be specified"
{::inclusion-patterns inclusion-patterns
::exclusion-patterns exclusion-patterns}))
:else
(let [inclusion? exclusion-blank?
pattern (schema-pattern->re-pattern (if inclusion? inclusion-patterns exclusion-patterns))]
(fn [s]
(let [m (.matcher pattern s)
matches? (.matches m)]
(if inclusion? matches? (not matches?)))))))) | |
(def ^:private schema-patterns->filter-fn (memoize schema-patterns->filter-fn*)) | |
Given an optional | (defn db-details->schema-filter-patterns
{:added "0.42.0"}
([database]
(let [{prop-name :name} (driver.u/find-schema-filters-prop (driver.u/database->driver database))]
(db-details->schema-filter-patterns prop-name database)))
([prop-nm {db-details :details :as _database}]
(let [schema-filter-type (get db-details (keyword (str prop-nm "-type")))
schema-filter-patterns (get db-details (keyword (str prop-nm "-patterns")))]
(case schema-filter-type
"exclusion" [nil schema-filter-patterns]
"inclusion" [schema-filter-patterns nil]
[nil nil])))) |
Returns true if the given | (defn include-schema?
{:added "0.42.0"}
([database schema-name]
(let [[inclusion-patterns exclusion-patterns] (db-details->schema-filter-patterns database)]
(include-schema? inclusion-patterns exclusion-patterns schema-name)))
([inclusion-patterns exclusion-patterns schema-name]
(let [filter-fn (schema-patterns->filter-fn inclusion-patterns exclusion-patterns)]
(filter-fn schema-name)))) |
Utility functions for common operations on drivers. | (ns metabase.driver.util (:require [clojure.core.memoize :as memoize] [clojure.set :as set] [clojure.string :as str] [metabase.config :as config] [metabase.db.connection :as mdb.connection] [metabase.driver :as driver] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.protocols :as lib.metadata.protocols] [metabase.lib.schema.id :as lib.schema.id] [metabase.models.setting :refer [defsetting]] [metabase.public-settings.premium-features :as premium-features] [metabase.query-processor.error-type :as qp.error-type] [metabase.query-processor.store :as qp.store] [metabase.util :as u] [metabase.util.i18n :refer [deferred-tru trs]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms]) (:import (java.io ByteArrayInputStream) (java.security KeyFactory KeyStore PrivateKey) (java.security.cert Certificate CertificateFactory X509Certificate) (java.security.spec PKCS8EncodedKeySpec) (javax.net SocketFactory) (javax.net.ssl KeyManagerFactory SSLContext TrustManagerFactory X509TrustManager))) |
(set! *warn-on-reflection* true) | |
Generic error messages that drivers should return in their implementation of [[metabase.driver/humanize-connection-error-message]]. | (def ^:private connection-error-messages
{:cannot-connect-check-host-and-port
{:message (deferred-tru
(str "Hmm, we couldn''t connect to the database."
" "
"Make sure your Host and Port settings are correct"))
:errors {:host (deferred-tru "check your host settings")
:port (deferred-tru "check your port settings")}}
:ssh-tunnel-auth-fail
{:message (deferred-tru
(str "We couldn''t connect to the SSH tunnel host."
" "
"Check the Username and Password."))
:errors {:tunnel-user (deferred-tru "check your username")
:tunnel-pass (deferred-tru "check your password")}}
:ssh-tunnel-connection-fail
{:message (deferred-tru
(str "We couldn''t connect to the SSH tunnel host."
" "
"Check the Host and Port."))
:errors {:tunnel-host (deferred-tru "check your host settings")
:tunnel-port (deferred-tru "check your port settings")}}
:database-name-incorrect
{:message (deferred-tru "Looks like the Database name is incorrect.")
:errors {:dbname (deferred-tru "check your database name settings")}}
:invalid-hostname
{:message (deferred-tru
(str "It looks like your Host is invalid."
" "
"Please double-check it and try again."))
:errors {:host (deferred-tru "check your host settings")}}
:password-incorrect
{:message (deferred-tru "Looks like your Password is incorrect.")
:errors {:password (deferred-tru "check your password")}}
:password-required
{:message (deferred-tru "Looks like you forgot to enter your Password.")
:errors {:password (deferred-tru "check your password")}}
:username-incorrect
{:message (deferred-tru "Looks like your Username is incorrect.")
:errors {:user (deferred-tru "check your username")}}
:username-or-password-incorrect
{:message (deferred-tru "Looks like the Username or Password is incorrect.")
:errors {:user (deferred-tru "check your username")
:password (deferred-tru "check your password")}}
:certificate-not-trusted
{:message (deferred-tru "Server certificate not trusted - did you specify the correct SSL certificate chain?")}
:unsupported-ssl-key-type
{:message (deferred-tru "Unsupported client SSL key type - are you using an RSA key?")}
:invalid-key-format
{:message (deferred-tru "Invalid client SSL key - did you select the correct file?")}
:requires-ssl
{:message (deferred-tru "Server appears to require SSL - please enable SSL below")
:errors {:ssl (deferred-tru "please enable SSL")}}
:implicitly-relative-db-file-path
{:message (deferred-tru "Implicitly relative file paths are not allowed.")
:errors {:db (deferred-tru "check your connection string")}}
:db-file-not-found
{:message (deferred-tru "Database cannot be found.")
:errors {:db (deferred-tru "check your connection string")}}}) |
(defn- tr-connection-error-messages [error-type-kw]
(when-let [message (connection-error-messages error-type-kw)]
(cond-> message
(contains? message :message) (update :message str)
(contains? message :errors) (update :errors update-vals str)))) | |
(comment mdb.connection/keep-me) ; used for [[memoize/ttl]] | |
Consider [[metabase.driver/can-connect?]] / [[can-connect-with-details?]] to have failed if they were not able to successfully connect after this many milliseconds. By default, this is 10 seconds. This is normally set via the env var | (defsetting db-connection-timeout-ms
:visibility :internal
:export? false
:type :integer
;; for TESTS use a timeout time of 3 seconds. This is because we have some tests that check whether
;; [[driver/can-connect?]] is failing when it should, and we don't want them waiting 10 seconds to fail.
;;
;; Don't set the timeout too low -- I've had Circle fail when the timeout was 1000ms on *one* occasion.
:default (if config/is-test?
3000
10000)) |
(defn- connection-error? [^Throwable throwable]
(and (some? throwable)
(or (instance? java.net.ConnectException throwable)
(recur (.getCause throwable))))) | |
Check whether we can connect to a database with (can-connect-with-details? :postgres {:host "localhost", :port 5432, ...}) | (defn can-connect-with-details?
^Boolean [driver details-map & [throw-exceptions]]
{:pre [(keyword? driver) (map? details-map)]}
(if throw-exceptions
(try
(u/with-timeout (db-connection-timeout-ms)
(or (driver/can-connect? driver details-map)
(throw (Exception. "Failed to connect to Database"))))
;; actually if we are going to `throw-exceptions` we'll rethrow the original but attempt to humanize the message
;; first
(catch Throwable e
(log/errorf e "Failed to connect to Database")
(throw (if-let [humanized-message (some->> (.getMessage e)
(driver/humanize-connection-error-message driver))]
(let [error-data (cond
(keyword? humanized-message)
(tr-connection-error-messages humanized-message)
(connection-error? e)
(tr-connection-error-messages :cannot-connect-check-host-and-port)
:else
{:message humanized-message})]
(ex-info (str (:message error-data)) error-data e))
e))))
(try
(can-connect-with-details? driver details-map :throw-exceptions)
(catch Throwable e
(log/error e (trs "Failed to connect to database"))
false)))) |
+----------------------------------------------------------------------------------------------------------------+ | Driver Resolution | +----------------------------------------------------------------------------------------------------------------+ | |
(def ^:private ^{:arglists '([db-id])} database->driver*
(memoize/ttl
(-> (mu/fn :- :keyword
[db-id :- ::lib.schema.id/database]
(qp.store/with-metadata-provider db-id
(:engine (lib.metadata.protocols/database (qp.store/metadata-provider)))))
(vary-meta assoc ::memoize/args-fn (fn [[db-id]]
[(mdb.connection/unique-identifier) db-id])))
:ttl/threshold 1000)) | |
(mu/defn database->driver :- :keyword
"Look up the driver that should be used for a Database. Lightly cached.
(This is cached for a second, so as to avoid repeated application DB calls if this function is called several times
over the duration of a single API request or sync operation.)"
[database-or-id :- [:or
{:error/message "Database or ID"}
[:map
[:engine [:or :keyword :string]]]
[:map
[:id ::lib.schema.id/database]]
::lib.schema.id/database]]
(if-let [driver (:engine database-or-id)]
;; ensure we get the driver as a keyword (sometimes it's a String)
(keyword driver)
(if (qp.store/initialized?)
(:engine (lib.metadata/database (qp.store/metadata-provider)))
(database->driver* (u/the-id database-or-id))))) | |
+----------------------------------------------------------------------------------------------------------------+ | Available Drivers Info | +----------------------------------------------------------------------------------------------------------------+ | |
Return a set of all features supported by | (defn features
[driver database]
(set (for [feature driver/driver-features
:when (driver/database-supports? driver feature database)]
feature))) |
Return a set of all currently available drivers. | (defn available-drivers
[]
(set (for [driver (descendants driver/hierarchy :metabase.driver/driver)
:when (driver/available? driver)]
driver))) |
(mu/defn semantic-version-gte :- :boolean
"Returns true if xv is greater than or equal to yv according to semantic versioning.
xv and yv are sequences of integers of the form `[major minor ...]`, where only
major is obligatory.
Examples:
(semantic-version-gte [4 1] [4 1]) => true
(semantic-version-gte [4 0 1] [4 1]) => false
(semantic-version-gte [4 1] [4]) => true
(semantic-version-gte [3 1] [4]) => false"
[xv :- [:maybe [:sequential ms/IntGreaterThanOrEqualToZero]]
yv :- [:maybe [:sequential ms/IntGreaterThanOrEqualToZero]]]
(loop [xv (seq xv), yv (seq yv)]
(or (nil? yv)
(let [[x & xs] xv
[y & ys] yv
x (if (nil? x) 0 x)
y (if (nil? y) 0 y)]
(or (> x y)
(and (>= x y) (recur xs ys))))))) | |
(defn- file-upload-props [{prop-name :name, visible-if :visible-if, disp-nm :display-name, :as conn-prop}]
(if (premium-features/is-hosted?)
[(-> (assoc conn-prop
:name (str prop-name "-value")
:type "textFile"
:treat-before-posting "base64")
(dissoc :secret-kind))]
[(cond-> {:name (str prop-name "-options")
:display-name disp-nm
:type "select"
:options [{:name (trs "Local file path")
:value "local"}
{:name (trs "Uploaded file path")
:value "uploaded"}]
:default "local"}
visible-if (assoc :visible-if visible-if))
(-> {:name (str prop-name "-value")
:type "textFile"
:treat-before-posting "base64"
:visible-if {(keyword (str prop-name "-options")) "uploaded"}}
(dissoc :secret-kind))
{:name (str prop-name "-path")
:type "string"
:display-name (trs "File path")
:placeholder (:placeholder conn-prop)
:visible-if {(keyword (str prop-name "-options")) "local"}}])) | |
Turns | (defn- ->str
[k]
(if (keyword? k)
(name k)
(str k))) |
(defn- expand-secret-conn-prop [{prop-name :name, :as conn-prop}]
(case (->str (:secret-kind conn-prop))
"password" [(-> conn-prop
(assoc :type "password")
(assoc :name (str prop-name "-value"))
(dissoc :secret-kind))]
"keystore" (file-upload-props conn-prop)
;; this may not necessarily be a keystore (could be a standalone PKCS-8 or PKCS-12 file)
"binary-blob" (file-upload-props conn-prop)
;; PEM is a plaintext format
;; TODO: do we need to also allow a textarea type paste for this? would require another special case
"pem-cert" (file-upload-props conn-prop)
[conn-prop])) | |
Invokes the getter function on a info type connection property and adds it to the connection property map as its placeholder value. Returns nil if no placeholder value or getter is provided, or if the getter returns a non-string value or throws an exception. | (defn- resolve-info-conn-prop
[{ getter :getter, placeholder :placeholder, :as conn-prop}]
(let [content (or placeholder
(try (getter)
(catch Throwable e
(log/error e (trs "Error invoking getter for connection property {0}"
(:name conn-prop))))))]
(when (string? content)
(-> conn-prop
(assoc :placeholder content)
(dissoc :getter))))) |
(defn- expand-schema-filters-prop [prop]
(let [prop-name (:name prop)
disp-name (or (:display-name prop) )
type-prop-nm (str prop-name "-type")]
[{:name type-prop-nm
:display-name disp-name
:type "select"
:options [{:name (trs "All")
:value "all"}
{:name (trs "Only these...")
:value "inclusion"}
{:name (trs "All except...")
:value "exclusion"}]
:default "all"}
{:name (str prop-name "-patterns")
:type "text"
:placeholder "E.x. public,auth*"
:description (trs "Comma separated names of {0} that should appear in Metabase" (u/lower-case-en disp-name))
:visible-if {(keyword type-prop-nm) "inclusion"}
:helper-text (trs "You can use patterns like \"auth*\" to match multiple {0}" (u/lower-case-en disp-name))
:required true}
{:name (str prop-name "-patterns")
:type "text"
:placeholder "E.x. public,auth*"
:description (trs "Comma separated names of {0} that should NOT appear in Metabase" (u/lower-case-en disp-name))
:visible-if {(keyword type-prop-nm) "exclusion"}
:helper-text (trs "You can use patterns like \"auth*\" to match multiple {0}" (u/lower-case-en disp-name))
:required true}])) | |
Finds the first property of type | (defn find-schema-filters-prop
[driver]
(first (filter (fn [conn-prop]
(= :schema-filters (keyword (:type conn-prop))))
(driver/connection-properties driver)))) |
Transforms This transforms :type :secret properties from the server side definition into other types for client display/editing. For example, a :secret-kind :keystore turns into a bunch of different properties, to encapsulate all the different options that might be available on the client side for populating the value. This also resolves the :getter function on :type :info properties, if one was provided. | (defn connection-props-server->client
{:added "0.42.0"}
[driver conn-props]
(let [res (reduce (fn [acc conn-prop]
;; TODO: change this to expanded- and use that as the basis for all calcs below (not conn-prop)
(let [expanded-props (case (keyword (:type conn-prop))
:secret
(expand-secret-conn-prop conn-prop)
:info
(if-let [conn-prop' (resolve-info-conn-prop conn-prop)]
[conn-prop']
[])
:schema-filters
(expand-schema-filters-prop conn-prop)
[conn-prop])]
(-> (update acc ::final-props concat expanded-props)
(update ::props-by-name merge (into {} (map (fn [p]
[(:name p) p])) expanded-props)))))
{::final-props [] ::props-by-name {}}
conn-props)
{::keys [final-props props-by-name]} res]
;; now, traverse the visible-if-edges and update all visible-if entries with their full set of "transitive"
;; dependencies (if property x depends on y having a value, but y itself depends on z having a value, then x
;; should be hidden if y is)
(mapv (fn [prop]
(let [v-ifs* (loop [props* [prop]
acc {}]
(if (seq props*)
(let [all-visible-ifs (apply merge (map :visible-if props*))
transitive-props (map (comp (partial get props-by-name) ->str)
(keys all-visible-ifs))
next-acc (merge all-visible-ifs acc)
cyclic-props (set/intersection (into #{} (keys all-visible-ifs))
(into #{} (keys acc)))]
(if (empty? cyclic-props)
(recur transitive-props next-acc)
(-> (trs "Cycle detected resolving dependent visible-if properties for driver {0}: {1}"
driver cyclic-props)
(ex-info {:type qp.error-type/driver
:driver driver
:cyclic-visible-ifs cyclic-props})
throw)))
acc))]
(cond-> prop
(seq v-ifs*)
(assoc :visible-if v-ifs*))))
final-props))) |
A regex to match data-URL-encoded files uploaded via the frontend | (def data-url-pattern #"^data:[^;]+;base64,") |
Returns bytes from encoded frontend file upload string. | (defn decode-uploaded ^bytes [^String uploaded-data] (u/decode-base64-to-bytes (str/replace uploaded-data data-url-pattern ""))) |
Currently, this transforms client side values for the various back into :type :secret for storage on the server.
Sort of the opposite of | (defn db-details-client->server
{:added "0.42.0"}
[driver db-details]
(when db-details
(assert (some? driver))
(let [secret-names->props (reduce (fn [acc prop]
(if (= "secret" (:type prop))
(assoc acc (:name prop) prop)
acc))
{}
(driver/connection-properties driver))
secrets-server->client (reduce (fn [acc prop]
(assoc acc (keyword (:name prop)) prop))
{}
(connection-props-server->client driver (vals secret-names->props)))]
(reduce-kv (fn [acc prop-name _prop]
(let [subprop (fn [suffix]
(keyword (str prop-name suffix)))
path-kw (subprop "-path")
val-kw (subprop "-value")
source-kw (subprop "-source")
options-kw (subprop "-options")
path (path-kw acc)
get-treat (fn []
(let [options (options-kw acc)]
(when (= "uploaded" options)
;; the :treat-before-posting, if defined, would be applied to the client
;; version of the -value property (the :type "textFile" one)
(let [textfile-prop (val-kw secrets-server->client)]
(:treat-before-posting textfile-prop)))))
value (when-let [^String v (val-kw acc)]
(case (get-treat)
"base64" (decode-uploaded v)
v))]
(cond-> (assoc acc val-kw value)
;; keywords here are associated to nil, rather than being dissoced, because they will be merged
;; with the existing db-details blob to produce the final details
;; therefore, if we want a changed setting to take effect (i.e. switching from a file path to an
;; upload), then we need to ensure the nil value is merged, rather than the stale value from the
;; app DB being picked
path (-> ; from outer cond->
(assoc val-kw nil) ; local path specified; remove the -value entry, if it exists
(assoc source-kw :file-path)) ; and set the :source to :file-path
value (-> ; from outer cond->
(assoc path-kw nil) ; value specified; remove the -path entry, if it exists
(assoc source-kw nil)) ; and remove the :source mapping
true (dissoc (subprop "-options")))))
db-details
secret-names->props)))) |
The set of all official drivers | (def official-drivers
#{"athena"
"bigquery-cloud-sdk"
"druid"
"googleanalytics"
"h2"
"mongo"
"mysql"
"oracle"
"postgres"
"presto-jdbc"
"redshift"
"snowflake"
"sparksql"
"sqlite"
"sqlserver"
"vertica"}) |
The set of other drivers in the partnership program | (def partner-drivers
#{"clickhouse" "exasol" "firebolt" "materialize" "ocient" "starburst"}) |
Return the source type of the driver: official, partner, or community | (defn driver-source
[driver-name]
(cond
(contains? official-drivers driver-name) "official"
(contains? partner-drivers driver-name) "partner"
:else "community")) |
Return info about all currently available drivers, including their connection properties fields and supported
features. The output of | (defn available-drivers-info
[]
(into {} (for [driver (available-drivers)
:let [props (try
(->> (driver/connection-properties driver)
(connection-props-server->client driver))
(catch Throwable e
(log/error e (trs "Unable to determine connection properties for driver {0}" driver))))]
:when props]
;; TODO - maybe we should rename `details-fields` -> `connection-properties` on the FE as well?
[driver {:source {:type (driver-source (name driver))
:contact (driver/contact-info driver)}
:details-fields props
:driver-name (driver/display-name driver)
:superseded-by (driver/superseded-by driver)}]))) |
Available database engines | (defsetting engines :visibility :public :setter :none :getter available-drivers-info :doc false) |
+----------------------------------------------------------------------------------------------------------------+ | TLS Helpers | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- dn-for-cert [^X509Certificate cert] (.. cert getSubjectX500Principal getName)) | |
(defn- key-type [key-string]
(when-let [m (re-find #"^-----BEGIN (?:(\p{Alnum}+) )?PRIVATE KEY-----\n" key-string)]
(m 1))) | |
Parses an RSA private key from the PEM string | (defn- parse-rsa-key
^PrivateKey [key-string]
(let [algorithm (or (key-type key-string) "RSA")
key-base64 (-> key-string
(str/replace #"^-----BEGIN (?:(\p{Alnum}+) )?PRIVATE KEY-----\n" "")
(str/replace #"\n-----END (?:(\p{Alnum}+) )?PRIVATE KEY-----\s*$" "")
(str/replace #"\s" ""))
decoded (u/decode-base64-to-bytes key-base64)
key-factory (KeyFactory/getInstance algorithm)] ; TODO support other algorithms
(.generatePrivate key-factory (PKCS8EncodedKeySpec. decoded)))) |
Parses a collection of X509 certificates from the string | (defn- parse-certificates
[^String cert-string]
(let [cert-factory (CertificateFactory/getInstance "X.509")
cert-stream (ByteArrayInputStream. (.getBytes cert-string "UTF-8"))]
(.generateCertificates cert-factory cert-stream))) |
Generates a | (defn generate-identity-store
^KeyStore [key-string password cert-string]
(let [private-key (parse-rsa-key key-string)
certificates (parse-certificates cert-string)]
(doto (KeyStore/getInstance (KeyStore/getDefaultType))
(.load nil nil)
(.setKeyEntry (dn-for-cert (first certificates))
private-key
(char-array password)
(into-array Certificate certificates))))) |
Generates a | (defn generate-trust-store
^KeyStore [cert-string]
(let [certs (parse-certificates cert-string)
keystore (doto (KeyStore/getInstance (KeyStore/getDefaultType))
(.load nil nil))
;; this TrustManagerFactory is used for cloning the default certs into the new TrustManagerFactory
base-trust-manager-factory (doto (TrustManagerFactory/getInstance (TrustManagerFactory/getDefaultAlgorithm))
(.init ^KeyStore (cast KeyStore nil)))]
(doseq [cert certs]
(.setCertificateEntry keystore (dn-for-cert cert) cert))
(doseq [^X509TrustManager trust-mgr (.getTrustManagers base-trust-manager-factory)]
(when (instance? X509TrustManager trust-mgr)
(doseq [issuer (.getAcceptedIssuers trust-mgr)]
(.setCertificateEntry keystore (dn-for-cert issuer) issuer))))
keystore)) |
(defn- key-managers [private-key password own-cert]
(let [key-store (generate-identity-store private-key password own-cert)
key-manager-factory (KeyManagerFactory/getInstance (KeyManagerFactory/getDefaultAlgorithm))]
(.init key-manager-factory key-store (char-array password))
(.getKeyManagers key-manager-factory))) | |
(defn- trust-managers [trust-cert]
(let [trust-store (generate-trust-store trust-cert)
trust-manager-factory (TrustManagerFactory/getInstance (TrustManagerFactory/getDefaultAlgorithm))]
(.init trust-manager-factory trust-store)
(.getTrustManagers trust-manager-factory))) | |
Generates an | (defn ssl-socket-factory
^SocketFactory [& {:keys [private-key own-cert trust-cert]}]
(let [ssl-context (SSLContext/getInstance "TLS")]
(.init ssl-context
(when (and private-key own-cert) (key-managers private-key (str (random-uuid)) own-cert))
(when trust-cert (trust-managers trust-cert))
nil)
(.getSocketFactory ssl-context))) |
Set of fields that should always be obfuscated in API responses, as they contain sensitive data. | (def default-sensitive-fields
#{:password :pass :tunnel-pass :tunnel-private-key :tunnel-private-key-passphrase :access-token :refresh-token
:service-account-json}) |
Returns all sensitive fields that should be redacted in API responses for a given database. Calls get-sensitive-fields using the given database's driver, if that driver is valid and registered. Refer to get-sensitive-fields docstring for full details. | (defn sensitive-fields
[driver]
(if-some [conn-prop-fn (get-method driver/connection-properties driver)]
(let [all-fields (conn-prop-fn driver)
password-fields (filter #(contains? #{:password :secret} (get % :type)) all-fields)]
(into default-sensitive-fields (map (comp keyword :name) password-fields)))
default-sensitive-fields)) |
(ns metabase.email (:require [malli.core :as mc] [metabase.analytics.prometheus :as prometheus] [metabase.models.setting :as setting :refer [defsetting]] [metabase.util.i18n :refer [deferred-tru trs tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [metabase.util.retry :as retry] [postal.core :as postal] [postal.support :refer [make-props]]) (:import (javax.mail Session))) | |
(set! *warn-on-reflection* true) | |
https://github.com/metabase/metabase/issues/11879#issuecomment-713816386 | (when-not *compile-files* (System/setProperty "mail.mime.splitlongparameters" "false")) |
CONFIG | |
(defsetting email-from-address (deferred-tru "The email address you want to use for the sender of emails.") :default "notifications@metabase.com" :visibility :settings-manager :audit :getter) | |
(defsetting email-from-name (deferred-tru "The name you want to use for the sender of emails.") :visibility :settings-manager :audit :getter) | |
(defsetting bcc-enabled? (deferred-tru "Whether or not bcc emails are enabled, default behavior is that it is") :visibility :settings-manager :type :boolean :default true) | |
(def ^:private ReplyToAddresses [:maybe [:sequential ms/Email]]) | |
(def ^:private ^{:arglists '([reply-to-addresses])} validate-reply-to-addresses
(mc/validator ReplyToAddresses)) | |
(defsetting email-reply-to
(deferred-tru "The email address you want the replies to go to, if different from the from address.")
:type :json
:visibility :settings-manager
:audit :getter
:setter (fn [new-value]
(if (validate-reply-to-addresses new-value)
(setting/set-value-of-type! :json :email-reply-to new-value)
(throw (ex-info "Invalid reply-to address" {:value new-value}))))) | |
(defsetting email-smtp-host (deferred-tru "The address of the SMTP server that handles your emails.") :visibility :settings-manager :audit :getter) | |
(defsetting email-smtp-username (deferred-tru "SMTP username.") :visibility :settings-manager :audit :getter) | |
(defsetting email-smtp-password (deferred-tru "SMTP password.") :visibility :settings-manager :sensitive? true :audit :getter) | |
(defsetting email-smtp-port (deferred-tru "The port your SMTP server uses for outgoing emails.") :type :integer :visibility :settings-manager :audit :getter) | |
(defsetting email-smtp-security
(deferred-tru "SMTP secure connection protocol. (tls, ssl, starttls, or none)")
:type :keyword
:default :none
:visibility :settings-manager
:audit :raw-value
:setter (fn [new-value]
(when (some? new-value)
(assert (#{:tls :ssl :none :starttls} (keyword new-value))))
(setting/set-value-of-type! :keyword :email-smtp-security new-value))) | |
PUBLIC INTERFACE | |
Internal function used to send messages. Should take 2 args - a map of SMTP credentials, and a map of email details. Provided so you can swap this out with an "inbox" for test purposes. | (def ^{:arglists '([smtp-credentials email-details])} send-email!
postal/send-message) |
Check if email is enabled and that the mandatory settings are configured. | (defsetting email-configured? :type :boolean :visibility :public :setter :none :getter #(boolean (email-smtp-host)) :doc false) |
(defn- add-ssl-settings [m ssl-setting]
(merge
m
(case (keyword ssl-setting)
:tls {:tls true}
:ssl {:ssl true}
:starttls {:starttls.enable true
:starttls.required true}
{}))) | |
(defn- smtp-settings []
(-> {:host (email-smtp-host)
:user (email-smtp-username)
:pass (email-smtp-password)
:port (email-smtp-port)}
(add-ssl-settings (email-smtp-security)))) | |
(def ^:private EmailMessage
[:and
[:map {:closed true}
[:subject :string]
[:recipients [:sequential ms/Email]]
[:message-type [:enum :text :html :attachments]]
[:message [:or :string [:sequential :map]]]
[:bcc? {:optional true} [:maybe :boolean]]]
[:fn {:error/message (str "Bad message-type/message combo: message-type `:attachments` should have a sequence of maps as its message; "
"other types should have a String message.")}
(fn [{:keys [message-type message]}]
(if (= message-type :attachments)
(and (sequential? message) (every? map? message))
(string? message)))]]) | |
Send an email to one or more | (defn send-message-or-throw!
{:style/indent 0}
[{:keys [subject recipients message-type message] :as email}]
(try
(when-not (email-smtp-host)
(throw (ex-info (tru "SMTP host is not set.") {:cause :smtp-host-not-set})))
;; Now send the email
(let [to-type (if (:bcc? email) :bcc :to)]
(send-email! (smtp-settings)
(merge
{:from (if-let [from-name (email-from-name)]
(str from-name " <" (email-from-address) ">")
(email-from-address))
to-type recipients
:subject subject
:body (case message-type
:attachments message
:text message
:html [{:type "text/html; charset=utf-8"
:content message}])}
(when-let [reply-to (email-reply-to)]
{:reply-to reply-to}))))
(catch Throwable e
(prometheus/inc :metabase-email/message-errors)
(when (not= :smtp-host-not-set (:cause (ex-data e)))
(throw e)))
(finally
(prometheus/inc :metabase-email/messages)))) |
Like [[send-message-or-throw!]] but retries sending on errors according to the retry settings. | (mu/defn send-email-retrying! [email :- EmailMessage] ((retry/decorate send-message-or-throw!) email)) |
Schema for the response returned by various functions in [[metabase.email]]. Response will be a map with the key
| (def ^:private SMTPStatus
[:map {:closed true}
[::error [:maybe [:fn #(instance? Throwable %)]]]]) |
Send an email to one or more (email/send-message! {:subject "[Metabase] Password Reset Request" :recipients ["cam@metabase.com"] :message-type :text :message "How are you today?")} Upon success, this returns the | (defn send-message!
[& {:as msg-args}]
(try
(send-email-retrying! msg-args)
(catch Throwable e
(log/warn e (trs "Failed to send email"))
{::error e}))) |
(def ^:private SMTPSettings
[:map {:closed true}
[:host ms/NonBlankString]
[:port ms/PositiveInt]
;; TODO -- not sure which of these other ones are actually required or not, and which are optional.
[:user {:optional true} [:maybe :string]]
[:security {:optional true} [:maybe [:enum :tls :ssl :none :starttls]]]
[:pass {:optional true} [:maybe :string]]
[:sender {:optional true} [:maybe :string]]
[:sender-name {:optional true} [:maybe :string]]
[:reply-to {:optional true} [:maybe [:sequential ms/Email]]]]) | |
(mu/defn ^:private test-smtp-settings :- SMTPStatus
"Tests an SMTP configuration by attempting to connect and authenticate if an authenticated method is passed
in `:security`."
[{:keys [host port user pass sender security], :as details} :- SMTPSettings]
(try
(let [ssl? (= (keyword security) :ssl)
proto (if ssl? "smtps" "smtp")
details (-> details
(assoc :proto proto
:connectiontimeout "1000"
:timeout "4000")
(add-ssl-settings security))
session (doto (Session/getInstance (make-props sender details))
(.setDebug false))]
(with-open [transport (.getTransport session proto)]
(.connect transport host port user pass)))
{::error nil}
(catch Throwable e
(log/error e (trs "Error testing SMTP connection"))
{::error e}))) | |
(def ^:private email-security-order [:tls :starttls :ssl]) | |
Amount of time to wait between retrying SMTP connections with different security options. This delay exists to keep us from getting banned on Outlook.com. | (def ^:private ^Long retry-delay-ms 500) |
(mu/defn ^:private guess-smtp-security :- [:maybe [:enum :tls :starttls :ssl]]
"Attempts to use each of the security methods in security order with the same set of credentials. This is used only
when the initial connection attempt fails, so it won't overwrite a functioning configuration. If this uses something
other than the provided method, a warning gets printed on the config page.
If unable to connect with any security method, returns `nil`. Otherwise returns the security method that we were
able to connect successfully with."
[details :- SMTPSettings]
;; make sure this is not lazy, or chunking can cause some servers to block requests
(some
(fn [security-type]
(if-not (::error (test-smtp-settings (assoc details :security security-type)))
security-type
(do
(Thread/sleep retry-delay-ms) ; Try not to get banned from outlook.com
nil)))
email-security-order)) | |
(mu/defn test-smtp-connection :- [:or SMTPStatus SMTPSettings]
"Test the connection to an SMTP server to determine if we can send emails. Takes in a dictionary of properties such
as:
{:host \"localhost\"
:port 587
:user \"bigbird\"
:pass \"luckyme\"
:sender \"foo@mycompany.com\"
:security :tls}
Attempts to connect with different `:security` options. If able to connect successfully, returns working
[[SMTPSettings]]. If unable to connect with any `:security` options, returns an [[SMTPStatus]] with the `::error`."
[details :- SMTPSettings]
(let [initial-attempt (test-smtp-settings details)]
(if-not (::error initial-attempt)
details
(if-let [working-security-type (guess-smtp-security details)]
(assoc details :security working-security-type)
initial-attempt)))) | |
Convenience functions for sending templated email messages. Each function here should represent a single email. NOTE: we want to keep this about email formatting, so don't put heavy logic here RE: building data for emails. | (ns metabase.email.messages (:require [buddy.core.codecs :as codecs] [cheshire.core :as json] [clojure.core.cache :as cache] [clojure.java.io :as io] [hiccup.core :refer [html]] [java-time.api :as t] [medley.core :as m] [metabase.config :as config] [metabase.db.query :as mdb.query] [metabase.driver :as driver] [metabase.driver.util :as driver.u] [metabase.email :as email] [metabase.models.collection :as collection] [metabase.models.permissions :as perms] [metabase.models.user :refer [User]] [metabase.public-settings :as public-settings] [metabase.public-settings.premium-features :as premium-features] [metabase.pulse.markdown :as markdown] [metabase.pulse.parameters :as pulse-params] [metabase.pulse.render :as render] [metabase.pulse.render.image-bundle :as image-bundle] [metabase.pulse.render.js-svg :as js-svg] [metabase.pulse.render.style :as style] [metabase.query-processor.store :as qp.store] [metabase.query-processor.streaming :as qp.streaming] [metabase.query-processor.streaming.interface :as qp.si] [metabase.query-processor.streaming.xlsx :as qp.xlsx] [metabase.query-processor.timezone :as qp.timezone] [metabase.util :as u] [metabase.util.date-2 :as u.date] [metabase.util.encryption :as encryption] [metabase.util.i18n :as i18n :refer [trs tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.urls :as urls] [stencil.core :as stencil] [stencil.loader :as stencil-loader] [toucan2.core :as t2]) (:import (java.io File IOException OutputStream) (java.time LocalTime) (java.time.format DateTimeFormatter))) |
(set! *warn-on-reflection* true) | |
Return the user configured application name, or Metabase translated via tru if a name isn't configured. | (defn- app-name-trs
[]
(or (public-settings/application-name)
(trs "Metabase"))) |
Dev only -- disable template caching | (when config/is-dev?
(alter-meta! #'stencil/render-file assoc :style/indent 1)
(stencil-loader/set-cache (cache/ttl-cache-factory {} :ttl 0))) |
(defn- logo-url []
(let [url (public-settings/application-logo-url)]
(cond
(= url "app/assets/img/logo.svg") "http://static.metabase.com/email_logo.png"
:else nil))) | |
NOTE: disabling whitelabeled URLs for now since some email clients don't render them correctly We need to extract them and embed as attachments like we do in metabase.pulse.render.image-bundle (data-uri-svg? url) (themed-image-url url color) :else url | |
Bundle an icon. The available icons are defined in [[js-svg/icon-paths]]. | (defn- icon-bundle
[icon-name]
(let [color (style/primary-color)
png-bytes (js-svg/icon icon-name color)]
(-> (image-bundle/make-image-bundle :attachment png-bytes)
(image-bundle/image-bundle->attachment)))) |
(defn- button-style [color]
(str "display: inline-block; "
"box-sizing: border-box; "
"padding: 0.5rem 1.375rem; "
"font-size: 1.063rem; "
"font-weight: bold; "
"text-decoration: none; "
"cursor: pointer; "
"color: #fff; "
"border: 1px solid " color "; "
"background-color: " color "; "
"border-radius: 4px;")) | |
Various Context Helper Fns. Used to build Stencil template context | |
Context that is used across multiple email templates, and that is the same for all emails | (defn- common-context
[]
{:applicationName (public-settings/application-name)
:applicationColor (style/primary-color)
:applicationLogoUrl (logo-url)
:buttonStyle (button-style (style/primary-color))
:colorTextLight style/color-text-light
:colorTextMedium style/color-text-medium
:colorTextDark style/color-text-dark
:siteUrl (public-settings/site-url)}) |
Public Interface | |
Send an email to | (defn send-new-user-email!
[invited invitor join-url sent-from-setup?]
(let [company (or (public-settings/site-name) "Unknown")
message-body (stencil/render-file "metabase/email/new_user_invite"
(merge (common-context)
{:emailType "new_user_invite"
:invitedName (or (:first_name invited) (:email invited))
:invitorName (or (:first_name invitor) (:email invitor))
:invitorEmail (:email invitor)
:company company
:joinUrl join-url
:today (t/format "MMM' 'dd,' 'yyyy" (t/zoned-date-time))
:logoHeader true
:sentFromSetup sent-from-setup?}))]
(email/send-message!
{:subject (str (trs "You''re invited to join {0}''s {1}" company (app-name-trs)))
:recipients [(:email invited)]
:message-type :html
:message message-body}))) |
Return a sequence of email addresses for all Admin users. The first recipient will be the site admin (or oldest admin if unset), which is the address that should be used in
| (defn- all-admin-recipients
[]
(concat (when-let [admin-email (public-settings/admin-email)]
[admin-email])
(t2/select-fn-set :email 'User, :is_superuser true, :is_active true, {:order-by [[:id :asc]]}))) |
Send an email to the | (defn send-user-joined-admin-notification-email!
[new-user & {:keys [google-auth?]}]
{:pre [(map? new-user)]}
(let [recipients (all-admin-recipients)]
(email/send-message!
{:subject (str (if google-auth?
(trs "{0} created a {1} account" (:common_name new-user) (app-name-trs))
(trs "{0} accepted their {1} invite" (:common_name new-user) (app-name-trs))))
:recipients recipients
:message-type :html
:message (stencil/render-file "metabase/email/user_joined_notification"
(merge (common-context)
{:logoHeader true
:joinedUserName (or (:first_name new-user) (:email new-user))
:joinedViaSSO google-auth?
:joinedUserEmail (:email new-user)
:joinedDate (t/format "EEEE, MMMM d" (t/zoned-date-time)) ; e.g. "Wednesday, July 13". TODO - is this what we want?
:adminEmail (first recipients)
:joinedUserEditUrl (str (public-settings/site-url) "/admin/people")}))}))) |
Format and send an email informing the user how to reset their password. | (defn send-password-reset-email!
[email sso-source password-reset-url is-active?]
{:pre [(u/email? email)
((some-fn string? nil?) password-reset-url)]}
(let [google-sso? (= "google" sso-source)
message-body (stencil/render-file
"metabase/email/password_reset"
(merge (common-context)
{:emailType "password_reset"
:google google-sso?
:nonGoogleSSO (and (not google-sso?) (some? sso-source))
:passwordResetUrl password-reset-url
:logoHeader true
:isActive is-active?
:adminEmail (public-settings/admin-email)
:adminEmailSet (boolean (public-settings/admin-email))}))]
(email/send-message!
{:subject (trs "[{0}] Password Reset Request" (app-name-trs))
:recipients [email]
:message-type :html
:message message-body}))) |
Format and send an email informing the user that this is the first time we've seen a login from this device. Expects
login history information as returned by | (mu/defn send-login-from-new-device-email!
[{user-id :user_id, :keys [timestamp], :as login-history} :- [:map [:user_id pos-int?]]]
(let [user-info (or (t2/select-one ['User [:first_name :first-name] :email :locale] :id user-id)
(throw (ex-info (tru "User {0} does not exist" user-id)
{:user-id user-id, :status-code 404})))
user-locale (or (:locale user-info) (i18n/site-locale))
timestamp (u.date/format-human-readable timestamp user-locale)
context (merge (common-context)
{:first-name (:first-name user-info)
:device (:device_description login-history)
:location (:location login-history)
:timestamp timestamp})
message-body (stencil/render-file "metabase/email/login_from_new_device"
context)]
(email/send-message!
{:subject (trs "We''ve Noticed a New {0} Login, {1}" (app-name-trs) (:first-name user-info))
:recipients [(:email user-info)]
:message-type :html
:message message-body}))) |
Find emails for users that have an interest in monitoring the database. If oss that means admin users. If ee that also means users with monitoring and details permissions. | (defn- admin-or-ee-monitoring-details-emails
[database-id]
(let [monitoring (perms/application-perms-path :monitoring)
db-details (perms/feature-perms-path :details :yes database-id)
user-ids (when (premium-features/enable-advanced-permissions?)
(->> {:select [:pgm.user_id]
:from [[:permissions_group_membership :pgm]]
:join [[:permissions_group :pg] [:= :pgm.group_id :pg.id]]
:where [:and
[:exists {:select [1]
:from [[:permissions :p]]
:where [:and
[:= :p.group_id :pg.id]
[:= :p.object monitoring]]}]
[:exists {:select [1]
:from [[:permissions :p]]
:where [:and
[:= :p.group_id :pg.id]
[:= :p.object db-details]]}]]
:group-by [:pgm.user_id]}
mdb.query/query
(mapv :user_id)))]
(into
[]
(distinct)
(concat
(all-admin-recipients)
(when (seq user-ids)
(t2/select-fn-set :email User {:where [:and
[:= :is_active true]
[:in :id user-ids]]})))))) |
Format and send an email informing the user about errors in the persistent model refresh task. | (defn send-persistent-model-error-email!
[database-id persisted-infos trigger]
{:pre [(seq persisted-infos)]}
(let [database (:database (first persisted-infos))
emails (admin-or-ee-monitoring-details-emails database-id)
timezone (some-> database qp.timezone/results-timezone-id t/zone-id)
context {:database-name (:name database)
:errors
(for [[idx persisted-info] (m/indexed persisted-infos)
:let [card (:card persisted-info)
collection (or (:collection card)
(collection/root-collection-with-ui-details nil))]]
{:is-not-first (not= 0 idx)
:error (:error persisted-info)
:card-id (:id card)
:card-name (:name card)
:collection-name (:name collection)
;; February 1, 2022, 3:10 PM
:last-run-at (t/format "MMMM d, yyyy, h:mm a z" (t/zoned-date-time (:refresh_begin persisted-info) timezone))
:last-run-trigger trigger
:card-url (urls/card-url (:id card))
:collection-url (urls/collection-url (:id collection))
:caching-log-details-url (urls/tools-caching-details-url (:id persisted-info))})}
message-body (stencil/render-file "metabase/email/persisted-model-error"
(merge (common-context) context))]
(when (seq emails)
(email/send-message!
{:subject (trs "[{0}] Model cache refresh failed for {1}" (app-name-trs) (:name database))
:recipients (vec emails)
:message-type :html
:message message-body})))) |
Format and send an email to the system admin following up on the installation. | (defn send-follow-up-email!
[email]
{:pre [(u/email? email)]}
(let [context (merge (common-context)
{:emailType "notification"
:logoHeader true
:heading (trs "We hope you''ve been enjoying Metabase.")
:callToAction (trs "Would you mind taking a quick 5 minute survey to tell us how it’s going?")
:link "https://metabase.com/feedback/active"})
email {:subject (trs "[{0}] Tell us how things are going." (app-name-trs))
:recipients [email]
:message-type :html
:message (stencil/render-file "metabase/email/follow_up_email" context)}]
(email/send-message! email))) |
(defn- make-message-attachment [[content-id url]]
{:type :inline
:content-id content-id
:content-type "image/png"
:content url}) | |
(defn- pulse-link-context
[{:keys [cards dashboard_id]}]
(when-let [dashboard-id (or dashboard_id
(some :dashboard_id cards))]
{:pulseLink (urls/dashboard-url dashboard-id)})) | |
Generates hash to allow for non-users to unsubscribe from pulses/subscriptions. | (defn generate-pulse-unsubscribe-hash
[pulse-id email]
(codecs/bytes->hex
(encryption/validate-and-hash-secret-key
(json/generate-string {:salt (public-settings/site-uuid-for-unsubscribing-url)
:email email
:pulse-id pulse-id})))) |
(defn- pulse-context [pulse dashboard non-user-email]
(let [dashboard-id (:id dashboard)]
(merge (common-context)
{:emailType "pulse"
:title (:name pulse)
:titleUrl (pulse-params/dashboard-url dashboard-id (pulse-params/parameters pulse dashboard))
:dashboardDescription (:description dashboard)
;; There are legacy pulses that exist without being tied to a dashboard
:dashboardHasTabs (when dashboard-id
(boolean (seq (t2/hydrate dashboard :tabs))))
:creator (-> pulse :creator :common_name)
:sectionStyle (style/style (style/section-style))
:notificationText (if (nil? non-user-email)
"Manage your subscriptions"
"Unsubscribe")
:notificationManagementUrl (if (nil? non-user-email)
(urls/notification-management-url)
(str (urls/unsubscribe-url)
"?hash=" (generate-pulse-unsubscribe-hash (:id pulse) non-user-email)
"&email=" non-user-email
"&pulse-id=" (:id pulse)))}
(pulse-link-context pulse)))) | |
Separate from | (defn- create-temp-file
[suffix]
(doto (File/createTempFile "metabase_attachment" suffix)
.deleteOnExit)) |
Tries to create a temp file, will give the users a better error message if we are unable to create the temp file | (defn- create-temp-file-or-throw
[suffix]
(try
(create-temp-file suffix)
(catch IOException e
(let [ex-msg (tru "Unable to create temp file in `{0}` for email attachments "
(System/getProperty "java.io.tmpdir"))]
(throw (IOException. ex-msg e)))))) |
(defn- create-result-attachment-map [export-type card-name ^File attachment-file]
(let [{:keys [content-type]} (qp.si/stream-options export-type)]
{:type :attachment
:content-type content-type
:file-name (format "%s.%s" card-name (name export-type))
:content (-> attachment-file .toURI .toURL)
:description (format "More results for '%s'" card-name)})) | |
For legacy compatibility. Takes QP results in the normal TODO -- this function is provided mainly because rewriting all the Pulse/Alert code to stream results directly was a lot of work. I intend to rework that code so we can stream directly to the correct export format(s) at some point in the future; for now, this function is a stopgap. Results are streamed synchronously. Caller is responsible for closing | (defn- stream-api-results-to-export-format
[export-format ^OutputStream os {{:keys [rows]} :data, database-id :database_id, :as results}]
;; make sure Database/driver info is available for the streaming results writers -- they might need this in order to
;; get timezone information when writing results
(driver/with-driver (driver.u/database->driver database-id)
(qp.store/with-metadata-provider database-id
(binding [qp.xlsx/*parse-temporal-string-values* true]
(let [w (qp.si/streaming-results-writer export-format os)
cols (-> results :data :cols)
viz-settings (-> results :data :viz-settings)
[ordered-cols output-order] (qp.streaming/order-cols cols viz-settings)
viz-settings' (assoc viz-settings :output-order output-order)]
(qp.si/begin! w
(assoc-in results [:data :ordered-cols] ordered-cols)
viz-settings')
(dorun
(map-indexed
(fn [i row]
(qp.si/write-row! w row i ordered-cols viz-settings'))
rows))
(qp.si/finish! w results)))))) |
(defn- result-attachment
[{{card-name :name :as card} :card {{:keys [rows]} :data :as result} :result}]
(when (seq rows)
[(when-let [temp-file (and (:include_csv card)
(create-temp-file-or-throw "csv"))]
(with-open [os (io/output-stream temp-file)]
(stream-api-results-to-export-format :csv os result))
(create-result-attachment-map "csv" card-name temp-file))
(when-let [temp-file (and (:include_xls card)
(create-temp-file-or-throw "xlsx"))]
(with-open [os (io/output-stream temp-file)]
(stream-api-results-to-export-format :xlsx os result))
(create-result-attachment-map "xlsx" card-name temp-file))])) | |
(defn- part-attachments [parts] (filter some? (mapcat result-attachment parts))) | |
(defn- render-part
[timezone part]
(case (:type part)
:card
(render/render-pulse-section timezone part)
:text
{:content (markdown/process-markdown (:text part) :html)}
:tab-title
{:content (markdown/process-markdown (format "# %s\n---" (:text part)) :html)})) | |
(defn- render-filters
[notification dashboard]
(let [filters (pulse-params/parameters notification dashboard)
cells (map
(fn [filter]
[:td {:class "filter-cell"
:style (style/style {:width "50%"
:padding "0px"
:vertical-align "baseline"})}
[:table {:cellpadding "0"
:cellspacing "0"
:width "100%"
:height "100%"}
[:tr
[:td
{:style (style/style {:color style/color-text-medium
:min-width "100px"
:width "50%"
:padding "4px 4px 4px 0"
:vertical-align "baseline"})}
(:name filter)]
[:td
{:style (style/style {:color style/color-text-dark
:min-width "100px"
:width "50%"
:padding "4px 16px 4px 8px"
:vertical-align "baseline"})}
(pulse-params/value-string filter)]]]])
filters)
rows (partition 2 2 nil cells)]
(html
[:table {:style (style/style {:table-layout :fixed
:border-collapse :collapse
:cellpadding "0"
:cellspacing "0"
:width "100%"
:font-size "12px"
:font-weight 700
:margin-top "8px"})}
(for [row rows]
[:tr {} row])]))) | |
(defn- render-message-body
[notification message-type message-context timezone dashboard parts]
(let [rendered-cards (binding [render/*include-title* true]
(mapv #(render-part timezone %) parts))
icon-name (case message-type
:alert :bell
:pulse :dashboard)
icon-attachment (first (map make-message-attachment (icon-bundle icon-name)))
filters (when dashboard
(render-filters notification dashboard))
message-body (assoc message-context :pulse (html (vec (cons :div (map :content rendered-cards))))
:filters filters
:iconCid (:content-id icon-attachment))
attachments (apply merge (map :attachments rendered-cards))]
(vec (concat [{:type "text/html; charset=utf-8" :content (stencil/render-file "metabase/email/pulse" message-body)}]
(map make-message-attachment attachments)
[icon-attachment]
(part-attachments parts))))) | |
(defn- assoc-attachment-booleans [pulse results]
(for [{{result-card-id :id} :card :as result} results
:let [pulse-card (m/find-first #(= (:id %) result-card-id) (:cards pulse))]]
(if result-card-id
(update result :card merge (select-keys pulse-card [:include_csv :include_xls]))
result))) | |
Take a pulse object and list of results, returns an array of attachment objects for an email | (defn render-pulse-email
[timezone pulse dashboard parts non-user-email]
(render-message-body pulse
:pulse
(pulse-context pulse dashboard non-user-email)
timezone
dashboard
(assoc-attachment-booleans pulse parts))) |
Given an | (defn pulse->alert-condition-kwd
[{:keys [alert_above_goal alert_condition] :as _alert}]
(if (= "goal" alert_condition)
(if (true? alert_above_goal)
:meets
:below)
:rows)) |
Alerts only have a single card, so the alerts API accepts a | (defn- first-card
[alert]
(or (:card alert)
(first (:cards alert)))) |
Template context that is applicable to all alert templates, including alert management templates (e.g. the subscribed/unsubscribed emails) | (defn- common-alert-context
([alert]
(common-alert-context alert nil))
([alert alert-condition-map]
(let [{card-id :id, card-name :name} (first-card alert)]
(merge (common-context)
{:emailType "alert"
:questionName card-name
:questionURL (urls/card-url card-id)
:sectionStyle (style/section-style)}
(when alert-condition-map
{:alertCondition (get alert-condition-map (pulse->alert-condition-kwd alert))}))))) |
(defn- schedule-hour-text
[{hour :schedule_hour}]
(.format (LocalTime/of hour 0)
(DateTimeFormatter/ofPattern "h a"))) | |
(defn- schedule-day-text
[{day :schedule_day}]
(get {"sun" "Sunday"
"mon" "Monday"
"tue" "Tuesday"
"wed" "Wednesday"
"thu" "Thursday"
"fri" "Friday"
"sat" "Saturday"}
day)) | |
(defn- schedule-timezone [] (or (driver/report-timezone) "UTC")) | |
Returns a string that describes the run schedule of an alert (i.e. how often results are checked), for inclusion in the email template. Not translated, since emails in general are not currently translated. | (defn- alert-schedule-text
[channel]
(case (:schedule_type channel)
:hourly
"Run hourly"
:daily
(format "Run daily at %s %s"
(schedule-hour-text channel)
(schedule-timezone))
:weekly
(format "Run weekly on %s at %s %s"
(schedule-day-text channel)
(schedule-hour-text channel)
(schedule-timezone)))) |
Context that is applicable only to the actual alert template (not alert management templates) | (defn- alert-context
[alert channel non-user-email]
(let [{card-id :id, card-name :name} (first-card alert)]
{:title card-name
:titleUrl (urls/card-url card-id)
:alertSchedule (alert-schedule-text channel)
:notificationManagementUrl (if (nil? non-user-email)
(urls/notification-management-url)
(str (urls/unsubscribe-url)
"?hash=" (generate-pulse-unsubscribe-hash (:id alert) non-user-email)
"&email=" non-user-email
"&pulse-id=" (:id alert)))
:creator (-> alert :creator :common_name)})) |
(defn- alert-results-condition-text [goal-value]
{:meets (format "This question has reached its goal of %s." goal-value)
:below (format "This question has gone below its goal of %s." goal-value)}) | |
Take a pulse object and list of results, returns an array of attachment objects for an email | (defn render-alert-email
[timezone {:keys [alert_first_only] :as alert} channel results goal-value non-user-email]
(let [message-ctx (merge
(common-alert-context alert (alert-results-condition-text goal-value))
(alert-context alert channel non-user-email))]
(render-message-body alert
:alert
(assoc message-ctx :firstRunOnly? alert_first_only)
timezone
nil
(assoc-attachment-booleans alert results)))) |
(def ^:private alert-condition-text
{:meets "when this question meets its goal"
:below "when this question goes below its goal"
:rows "whenever this question has any results"}) | |
Sends an email on a background thread, returning a future. | (defn- send-email!
[user subject template-path template-context]
(future
(try
(email/send-email-retrying!
{:recipients [(:email user)]
:message-type :html
:subject subject
:message (stencil/render-file template-path template-context)})
(catch Exception e
(log/errorf e "Failed to send message to '%s' with subject '%s'" (:email user) subject))))) |
(defn- template-path [template-name] (str "metabase/email/" template-name ".mustache")) | |
Paths to the templates for all of the alerts emails | (def ^:private new-alert-template (template-path "alert_new_confirmation")) (def ^:private you-unsubscribed-template (template-path "alert_unsubscribed")) (def ^:private admin-unsubscribed-template (template-path "alert_admin_unsubscribed_you")) (def ^:private added-template (template-path "alert_you_were_added")) (def ^:private stopped-template (template-path "alert_stopped_working")) (def ^:private archived-template (template-path "alert_archived")) |
Send out the initial 'new alert' email to the | (defn send-new-alert-email!
[{:keys [creator] :as alert}]
(send-email! creator "You set up an alert" new-alert-template
(common-alert-context alert alert-condition-text))) |
Send an email to | (defn send-you-unsubscribed-alert-email!
[alert who-unsubscribed]
(send-email! who-unsubscribed "You unsubscribed from an alert" you-unsubscribed-template
(common-alert-context alert))) |
Send an email to | (defn send-admin-unsubscribed-alert-email!
[alert user-added {:keys [first_name last_name] :as _admin}]
(let [admin-name (format "%s %s" first_name last_name)]
(send-email! user-added "You’ve been unsubscribed from an alert" admin-unsubscribed-template
(assoc (common-alert-context alert) :adminName admin-name)))) |
Send an email to | (defn send-you-were-added-alert-email!
[alert user-added {:keys [first_name last_name] :as _admin-adder}]
(let [subject (format "%s %s added you to an alert" first_name last_name)]
(send-email! user-added subject added-template (common-alert-context alert alert-condition-text)))) |
(def ^:private not-working-subject "One of your alerts has stopped working") | |
Email to notify users when a card associated to their alert has been archived Email to notify users when a card associated to their alert changed in a way that invalidates their alert | (defn send-alert-stopped-because-archived-email!
[alert user {:keys [first_name last_name] :as _archiver}]
(let [{card-id :id card-name :name} (first-card alert)]
(send-email! user not-working-subject archived-template {:archiveURL (urls/archive-url)
:questionName (format "%s (#%d)" card-name card-id)
:archiverName (format "%s %s" first_name last_name)})))
(defn send-alert-stopped-because-changed-email!
[alert user {:keys [first_name last_name] :as _archiver}]
(let [edited-text (format "the question was edited by %s %s" first_name last_name)]
(send-email! user not-working-subject stopped-template (assoc (common-alert-context alert) :deletionCause edited-text)))) |
Email all admins when a Slack API call fails due to a revoked token or other auth error | (defn send-slack-token-error-emails!
[]
(email/send-message!
:subject (trs "Your Slack connection stopped working")
:recipients (all-admin-recipients)
:message-type :html
:message (stencil/render-file "metabase/email/slack_token_error.mustache"
(merge (common-context)
{:logoHeader true
:settingsUrl (str (public-settings/site-url) "/admin/settings/slack")})))) |
Settings related to embedding Metabase in other applications. | (ns metabase.embed.settings (:require [metabase.analytics.snowplow :as snowplow] [metabase.api.common :as api] [metabase.models.setting :as setting :refer [defsetting]] [metabase.public-settings :as public-settings] [metabase.util.i18n :as i18n :refer [deferred-tru]] [toucan2.core :as t2])) |
(defsetting embedding-app-origin
(deferred-tru "Allow this origin to embed the full {0} application"
(public-settings/application-name-for-setting-descriptions))
:feature :embedding
:visibility :public
:audit :getter) | |
(defsetting enable-embedding
(deferred-tru "Allow admins to securely embed questions and dashboards within other applications?")
:type :boolean
:default false
:visibility :authenticated
:export? true
:audit :getter
:setter (fn [new-value]
(when (not= new-value (setting/get-value-of-type :boolean :enable-embedding))
(setting/set-value-of-type! :boolean :enable-embedding new-value)
(let [snowplow-payload {:embedding-app-origin-set (boolean (embedding-app-origin))
:number-embedded-questions (t2/count :model/Card :enable_embedding true)
:number-embedded-dashboards (t2/count :model/Dashboard :enable_embedding true)}]
(if new-value
(snowplow/track-event! ::snowplow/embedding-enabled api/*current-user-id* snowplow-payload)
(snowplow/track-event! ::snowplow/embedding-disabled api/*current-user-id* snowplow-payload)))))) | |
Provides a very simple Emacs Lisp hook-style events system using Methodical. See https://github.com/metabase/metabase/issues/19812 for more information. Publish an event, which consists of a [[Topic]] keyword and an event map using [[publish-event!]], 'subscribe' to events by writing method implementations of [[publish-event!]]. On launch, all namespaces starting with | (ns metabase.events
(:require
[clojure.spec.alpha :as s]
[metabase.events.schema :as events.schema]
[metabase.models.interface :as mi]
[metabase.plugins.classloader :as classloader]
[metabase.util :as u]
[metabase.util.i18n :as i18n]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.methodical.null-cache :as u.methodical.null-cache]
[metabase.util.methodical.unsorted-dispatcher
:as u.methodical.unsorted-dispatcher]
[methodical.core :as methodical]
[steffan-westcott.clj-otel.api.trace.span :as span])) |
(set! *warn-on-reflection* true) | |
Malli schema for an event topic keyword. | (def Topic
[:and
qualified-keyword?
[:fn
{:error/message "Events should derive from :metabase/event"}
#(isa? % :metabase/event)]]) |
(defonce ^:private events-initialized? (atom nil)) | |
Look for namespaces that start with | (defn- find-and-load-event-handlers!
[]
(doseq [ns-symb u/metabase-namespace-symbols
:when (.startsWith (name ns-symb) "metabase.events.")]
(log/info (i18n/trs "Loading events namespace:") (u/format-color 'blue ns-symb) (u/emoji "👂"))
(classloader/require ns-symb))) |
Initialize the asynchronous internal events system. | (defn- initialize-events!
[]
(when-not @events-initialized?
(locking events-initialized?
(when-not @events-initialized?
(find-and-load-event-handlers!)
(reset! events-initialized? true))))) |
(s/def ::publish-event-dispatch-value (s/and (some-fn qualified-keyword? #(= % :default)) #(not= (namespace %) "event"))) | |
'Publish' an event by calling [[publish-event!]] with a [[Topic]] and an (events/publish-event! :event/database-create {:object database :user-id api/current-user-id}) 'Subscribe' to an event by add a Methodical method implementation. Since this uses the [[methodical/do-method-combination]], all multiple method implementations can be called for a single invocation. The order is indeterminate, but return value is ignored. Don't write method implementations for the event names themselves, e.g. ;; bad! If someone else writes a method for Instead, derive the event from another key, and write a method for that ;; Good (derive :event/database-create ::events) (methodical/defmethod events/publish-event! ::events [topic event] ...) The schema for each event topic are defined in | (methodical/defmulti publish-event!
{:arglists '([topic event])
:defmethod-arities #{2}
:dispatch-value-spec ::publish-event-dispatch-value}
:combo
(methodical/do-method-combination)
;; work around https://github.com/camsaul/methodical/issues/97
:dispatcher
(u.methodical.unsorted-dispatcher/unsorted-dispatcher
(fn dispatch-fn [topic _event]
(keyword topic)))
;; work around https://github.com/camsaul/methodical/issues/98
:cache
(u.methodical.null-cache/null-cache)) |
(methodical/defmethod publish-event! :default [_topic _event] nil) | |
(methodical/defmethod publish-event! :around :default
[topic event]
(span/with-span!
{:name "publish-event!"
:attributes {:event/topic topic
:events/initialized (some? @events-initialized?)}}
(assert (not *compile-files*) "Calls to publish-event! are not allowed in the top level.")
(if-not @events-initialized?
;; if the event namespaces aren't initialized yet, make sure they're all loaded up before trying to do dispatch.
(do
(initialize-events!)
(publish-event! topic event))
(do
(span/with-span!
{:name "publish-event!.logging"
:attributes {}}
(let [{:keys [object]} event]
(log/debugf "Publishing %s event (name and id):\n\n%s"
(u/colorize :yellow (pr-str topic))
(u/pprint-to-str (let [model (mi/model object)]
(cond-> (select-keys object [:name :id])
model
(assoc :model model))))))
(assert (and (qualified-keyword? topic)
(isa? topic :metabase/event))
(format "Invalid event topic %s: events must derive from :metabase/event" (pr-str topic)))
(assert (map? event)
(format "Invalid event %s: event must be a map." (pr-str event))))
(try
(when-let [schema (events.schema/topic->schema topic)]
(mu/validate-throw schema event))
(span/with-span!
{:name "publish-event!.next-method"
:attributes {}}
(next-method topic event))
(catch Throwable e
(throw (ex-info (i18n/tru "Error publishing {0} event: {1}" topic (ex-message e))
{:topic topic, :event event}
e))))
event)))) | |
Determine metadata, if there is any, for given | (defn object->metadata
[object]
{:cached (:cached object)
:ignore_cache (:ignore_cache object)
;; the :context key comes from qp middleware:
;; [[metabase.query-processor.middleware.process-userland-query/add-and-save-execution-info-xform!]]
;; and is important for distinguishing view events triggered when pinned cards are 'viewed'
;; when a user opens a collection.
:context (:context object)}) |
This namespace is responsible for publishing events to the audit log. | (ns metabase.events.audit-log (:require [metabase.events :as events] [metabase.models.audit-log :as audit-log] [metabase.util :as u] [methodical.core :as methodical] [toucan2.core :as t2])) |
(derive ::event :metabase/event) | |
(derive ::card-event ::event) (derive :event/card-create ::card-event) (derive :event/card-update ::card-event) (derive :event/card-delete ::card-event) | |
(methodical/defmethod events/publish-event! ::card-event [topic event] (audit-log/record-event! topic event)) | |
(derive ::dashboard-event ::event) (derive :event/dashboard-create ::dashboard-event) (derive :event/dashboard-delete ::dashboard-event) | |
(methodical/defmethod events/publish-event! ::dashboard-event [topic event] (audit-log/record-event! topic event)) | |
(derive ::dashboard-card-event ::event) (derive :event/dashboard-add-cards ::dashboard-card-event) (derive :event/dashboard-remove-cards ::dashboard-card-event) | |
(methodical/defmethod events/publish-event! ::dashboard-card-event
[topic {:keys [object dashcards user-id] :as _event}]
;; we expect that the object has just a dashboard :id at the top level
;; plus a `:dashcards` attribute which is a vector of the cards added/removed
(let [cards (when (seq dashcards)
(t2/select-fn->fn :id #(select-keys % [:name :description])
:model/Card
:id [:in (map :card_id dashcards)]))
details (-> (select-keys object [:description :name :id])
(assoc :dashcards (for [{:keys [id card_id]} dashcards]
(-> (cards card_id)
(assoc :id id)
(assoc :card_id card_id)))))]
(audit-log/record-event! topic
{:details details
:user-id user-id
:model :model/Dashboard
:model-id (u/id object)}))) | |
(derive ::table-event ::event) (derive :event/table-manual-scan ::table-event) | |
(methodical/defmethod events/publish-event! ::table-event [topic event] (audit-log/record-event! topic event)) | |
(derive ::metric-event ::event) (derive :event/metric-create ::metric-event) (derive :event/metric-update ::metric-event) (derive :event/metric-delete ::metric-event) | |
(methodical/defmethod events/publish-event! ::metric-event
[topic {:keys [object user-id revision-message] :as _event}]
(audit-log/record-event! topic {:object object
:user-id user-id
:details (when revision-message {:revision-message revision-message})})) | |
(derive ::pulse-event ::event) (derive :event/pulse-create ::pulse-event) (derive :event/pulse-delete ::pulse-event) (derive :event/subscription-unsubscribe ::pulse-event) (derive :event/subscription-unsubscribe-undo ::pulse-event) (derive :event/alert-unsubscribe ::pulse-event) (derive :event/subscription-create ::pulse-event) (derive :event/subscription-update ::pulse-event) (derive :event/subscription-send ::pulse-event) (derive :event/alert-send ::pulse-event) | |
(defn- create-details-map [pulse name is-alert parent]
(let [channels (:channels pulse)
parent-id (if is-alert :card_id :dashboard_id)]
{:archived (:archived pulse)
:name name
parent-id parent
:parameters (:parameters pulse)
:channel (map :channel_type channels)
:schedule (map :schedule_type channels)
:recipients (map :recipients channels)})) | |
(methodical/defmethod events/publish-event! ::pulse-event
[topic {:keys [id object user-id] :as _event}]
;; Check if object contains the keys that we want populated, if not then may be a unsubscribe/send event
(let [details-map (if (some? (:id object))
(create-details-map object (:name object) false (:dashboard_id object))
object)
model-id (or id (:id object))]
(audit-log/record-event! topic
{:details details-map
:user-id user-id
:model :model/Pulse
:model-id model-id}))) | |
(derive ::alert-event ::event) (derive :event/alert-create ::alert-event) (derive :event/alert-delete ::alert-event) (derive :event/alert-update ::alert-event) | |
(methodical/defmethod events/publish-event! ::alert-event
[topic {:keys [object user-id] :as _event}]
(let [card (:card object)
card-name (:name card)]
;; Alerts are centered around a card/question. Users always interact with the alert via the question
(audit-log/record-event! topic
{:details (create-details-map object card-name true (:id card))
:user-id user-id
:model :model/Card
:model-id (:id object)}))) | |
(derive ::segment-event ::event) (derive :event/segment-create ::segment-event) (derive :event/segment-update ::segment-event) (derive :event/segment-delete ::segment-event) | |
(methodical/defmethod events/publish-event! ::segment-event
[topic {:keys [object user-id revision-message] :as _event}]
(audit-log/record-event! topic {:object object
:user-id user-id
:details (when revision-message {:revision-message revision-message})})) | |
(derive ::user-event ::event) (derive :event/user-invited ::user-event) (derive :event/user-deactivated ::user-event) (derive :event/user-reactivated ::user-event) (derive :event/password-reset-initiated ::user-event) (derive :event/password-reset-successful ::user-event) | |
(methodical/defmethod events/publish-event! ::user-event [topic event] (audit-log/record-event! topic event)) | |
(derive ::user-update-event ::event) (derive :event/user-update ::user-update-event) | |
(methodical/defmethod events/publish-event! ::user-update-event [topic event] (audit-log/record-event! topic event)) | |
(derive ::user-joined-event ::event) (derive :event/user-joined ::user-joined-event) | |
(methodical/defmethod events/publish-event! ::user-joined-event
[topic {:keys [user-id]}]
(audit-log/record-event! topic
{:user-id user-id
:model :model/User
:model-id user-id})) | |
(derive ::install-event ::event) (derive :event/install ::install-event) | |
(methodical/defmethod events/publish-event! ::install-event
[topic _event]
(when-not (t2/exists? :model/AuditLog :topic "install")
(audit-log/record-event! topic {}))) | |
(derive ::database-event ::event) (derive :event/database-create ::database-event) (derive :event/database-delete ::database-event) (derive :event/database-manual-sync ::database-event) (derive :event/database-manual-scan ::database-event) (derive :event/database-discard-field-values ::database-event) | |
(methodical/defmethod events/publish-event! ::database-event [topic event] (audit-log/record-event! topic event)) | |
(derive ::database-update-event ::event) (derive :event/database-update ::database-update-event) | |
(methodical/defmethod events/publish-event! ::database-update-event [topic event] (audit-log/record-event! topic event)) | |
(derive ::permission-failure-event ::event) (derive :event/write-permission-failure ::permission-failure-event) (derive :event/update-permission-failure ::permission-failure-event) (derive :event/create-permission-failure ::permission-failure-event) | |
(methodical/defmethod events/publish-event! ::permission-failure-event [topic event] (audit-log/record-event! topic event)) | |
(derive ::settings-changed-event ::event) (derive :event/setting-update ::settings-changed-event) | |
(methodical/defmethod events/publish-event! ::settings-changed-event [topic event] (audit-log/record-event! topic event)) | |
(derive ::api-key-event ::event) (derive :event/api-key-create ::api-key-event) (derive :event/api-key-update ::api-key-event) (derive :event/api-key-regenerate ::api-key-event) (derive :event/api-key-delete ::api-key-event) | |
(methodical/defmethod events/publish-event! ::api-key-event [topic event] (audit-log/record-event! topic event)) | |
Driver notifications are used to let drivers know database details or other relevant information has
changed ( | (ns metabase.events.driver-notifications (:require [medley.core :as m] [metabase.driver :as driver] [metabase.events :as events] [metabase.util.log :as log] [methodical.core :as methodical])) |
(derive ::event :metabase/event) (derive :event/database-update ::event) (derive :event/database-delete ::event) | |
(methodical/defmethod events/publish-event! ::event
[topic {database :object, previous-database :previous-object :as _event}]
;; try/catch here to prevent individual topic processing exceptions from bubbling up. better to handle them here.
(try
;; notify the appropriate driver about the updated database to release any related resources, such as connections.
;; avoid notifying if the changes shouldn't impact the observable behaviour of any resource, otherwise drivers might
;; close connections or other resources unnecessarily (metabase#27877).
(let [;; remove data that should not impact the observable state of any resource before comparing
remove-irrelevant-data (fn [db]
(reduce m/dissoc-in db [[:updated_at]
[:settings :database-enable-actions]]))]
(when (not= (remove-irrelevant-data database)
(remove-irrelevant-data previous-database))
(driver/notify-database-updated (:engine database) database)))
(catch Throwable e
(log/warnf e "Failed to process driver notifications event. %s" topic)))) | |
(ns metabase.events.last-login (:require [metabase.events :as events] [metabase.models.user :refer [User]] [metabase.util.log :as log] [methodical.core :as methodical] [toucan2.core :as t2])) | |
(derive ::event :metabase/event) (derive :event/user-login ::event) | |
(methodical/defmethod events/publish-event! ::event
[topic {:keys [user-id] :as _event}]
;; try/catch here to prevent individual topic processing exceptions from bubbling up. better to handle them here.
(when user-id
(try
;; just make a simple attempt to set the `:last_login` for the given user to now
(t2/update! User user-id {:last_login :%now})
(catch Throwable e
(log/warnf e "Failed to process sync-database event. %s" topic))))) | |
(ns metabase.events.persisted-info (:require [metabase.events :as events] [metabase.models :refer [Database PersistedInfo]] [metabase.models.persisted-info :as persisted-info] [metabase.public-settings :as public-settings] [metabase.util.log :as log] [methodical.core :as methodical] [toucan2.core :as t2])) | |
(derive ::event :metabase/event) (derive :event/card-create ::event) (derive :event/card-update ::event) | |
(methodical/defmethod events/publish-event! ::event
[topic {card :object :keys [user-id] :as _event}]
;; try/catch here to prevent individual topic processing exceptions from bubbling up. better to handle them here.
(try
;; We only want to add a persisted-info for newly created models where dataset is being set to true.
;; If there is already a PersistedInfo, even in "off" or "deletable" state, we skip it as this
;; is only supposed to be that initial edge when the dataset is being changed.
(when (and (:dataset card)
(public-settings/persisted-models-enabled)
(get-in (t2/select-one Database :id (:database_id card)) [:settings :persist-models-enabled])
(nil? (t2/select-one-fn :id PersistedInfo :card_id (:id card))))
(persisted-info/turn-on-model! user-id card))
(catch Throwable e
(log/warnf e "Failed to process persisted-info event. %s" topic)))) | |
This namespace is responsible for subscribing to events which should update the recent views for a user. | (ns metabase.events.recent-views (:require [metabase.api.common :as api] [metabase.events :as events] [metabase.models.audit-log :as audit-log] [metabase.models.recent-views :as recent-views] [metabase.util :as u] [metabase.util.log :as log] [methodical.core :as m] [steffan-westcott.clj-otel.api.trace.span :as span])) |
(derive ::event :metabase/event) | |
(derive :event/dashboard-read ::event) (derive :event/table-read ::event) | |
(m/defmethod events/publish-event! ::event
"Handle processing for a single event notification which should update the recent views for a user."
[topic {:keys [object user-id] :as _event}]
(span/with-span!
{:name (str "recent-views-" (name topic))
:topic topic
:user-id user-id}
(try
(when object
(let [model (audit-log/model-name object)
model-id (u/id object)
user-id (or user-id api/*current-user-id*)]
(recent-views/update-users-recent-views! user-id model model-id)))
(catch Throwable e
(log/warnf e "Failed to process recent_views event: %s" topic))))) | |
(derive ::card-query-event :metabase/event) (derive :event/card-query ::card-query-event) | |
(m/defmethod events/publish-event! ::card-query-event
"Handle processing for a single card query event."
[topic {:keys [card-id user-id context] :as _event}]
(span/with-span!
{:name (str "recent-views-" (name topic))
:topic topic
:card-id card-id
:user-id user-id}
(try
(let [model "card"
user-id (or user-id api/*current-user-id*)]
;; we don't want to count pinned card views
(when-not (#{:collection :dashboard} context)
(recent-views/update-users-recent-views! user-id model card-id)))
(catch Throwable e
(log/warnf e "Failed to process recent_views event: %s" topic))))) | |
(ns metabase.events.revision (:require [metabase.api.common :as api] [metabase.events :as events] [metabase.models.revision :as revision] [metabase.util.log :as log] [methodical.core :as methodical] [toucan2.core :as t2])) | |
(derive ::event :metabase/event) | |
(defn- push-revision!
[model
{:keys [user-id] object :object :as event}
{:keys [is-creation?]
:or {is-creation? false}
:as _options}]
(when event
(try
(when-not (t2/instance-of? model object)
(throw (ex-info "object must be a model instance" {:object object :model model})))
(let [user-id (or user-id api/*current-user-id*)]
(revision/push-revision! {:entity model
:id (:id object)
:object object
:user-id user-id
:is-creation? is-creation?
:message (:revision-message event)}))
(catch Throwable e
(log/warnf e "Failed to process revision event for model %s" model))))) | |
(derive ::card-event ::event) (derive :event/card-create ::card-event) (derive :event/card-update ::card-event) | |
(methodical/defmethod events/publish-event! ::card-event
[topic event]
(push-revision! :model/Card event {:is-creation? (= topic :event/card-create)})) | |
(derive ::dashboard-event ::event) (derive :event/dashboard-create ::dashboard-event) (derive :event/dashboard-update ::dashboard-event) | |
(methodical/defmethod events/publish-event! ::dashboard-event
[topic event]
(push-revision! :model/Dashboard event {:is-creation? (= topic :event/dashboard-create)})) | |
(derive ::metric-event ::event) (derive :event/metric-create ::metric-event) (derive :event/metric-update ::metric-event) (derive :event/metric-delete ::metric-event) | |
(methodical/defmethod events/publish-event! ::metric-event
[topic event]
(push-revision! :model/Metric event {:is-creation? (= topic :event/metric-create)})) | |
(derive ::segment-event ::event) (derive :event/segment-create ::segment-event) (derive :event/segment-update ::segment-event) (derive :event/segment-delete ::segment-event) | |
(methodical/defmethod events/publish-event! ::segment-event
[topic event]
(push-revision! :model/Segment event {:is-creation? (= topic :event/segment-create)})) | |
(ns metabase.events.schema (:require [malli.core :as mc] [malli.util :as mut] [toucan2.core :as t2])) | |
dashboard events | |
(let [default-schema (mc/schema
[:map {:closed true}
[:user-id pos-int?]
[:object [:fn #(t2/instance-of? :model/Dashboard %)]]])
view-only (mc/schema
[:map {:closed true}
[:user-id [:maybe pos-int?]]
[:object [:fn #(t2/instance-of? :model/Dashboard %)]]])
with-dashcards (mut/assoc default-schema
:dashcards [:sequential [:map [:id pos-int?]]])]
(def ^:private dashboard-events-schemas
{:event/dashboard-read view-only
:event/dashboard-create default-schema
:event/dashboard-update default-schema
:event/dashboard-delete default-schema
:event/dashboard-remove-cards with-dashcards
:event/dashboard-add-cards with-dashcards})) | |
card events | |
(let [default-schema (mc/schema
[:map {:closed true}
[:user-id pos-int?]
[:object [:fn #(t2/instance-of? :model/Card %)]]])]
(def ^:private card-events-schemas
{:event/card-create default-schema
:event/card-read default-schema
:event/card-update default-schema
:event/card-delete default-schema
:event/card-query [:map {:closed true}
[:card-id pos-int?]
[:user-id [:maybe pos-int?]]
[:context {:optional true} :any]]})) | |
user events | |
(let [default-schema (mc/schema
[:map {:closed true}
[:user-id pos-int?]])]
(def ^:private user-events-schema
{:event/user-login default-schema
:event/user-joined default-schema})) | |
metric events | |
(let [default-schema (mc/schema
[:map {:closed true}
[:user-id pos-int?]
[:object [:fn #(t2/instance-of? :model/Metric %)]]])
with-message (mc/schema [:merge default-schema
[:map {:closed true}
[:revision-message {:optional true} :string]]])]
(def ^:private metric-related-schema
{:event/metric-create default-schema
:event/metric-update with-message
:event/metric-delete with-message})) | |
segment events | |
(let [default-schema (mc/schema
[:map {:closed true}
[:user-id pos-int?]
[:object [:fn #(t2/instance-of? :model/Segment %)]]])
with-message (mc/schema
[:merge default-schema
[:map {:closed true}
[:revision-message {:optional true} :string]]])]
(def ^:private segment-related-schema
{:event/segment-create default-schema
:event/segment-update with-message
:event/segment-delete with-message})) | |
database events | |
(let [default-schema (mc/schema
[:map {:closed true}
[:object [:fn #(t2/instance-of? :model/Database %)]]
[:previous-object {:optional true} [:fn #(t2/instance-of? :model/Database %)]]
[:user-id pos-int?]])]
(def ^:private database-events
{:event/database-create default-schema
:event/database-update default-schema
:event/database-delete default-schema})) | |
alert schemas | (def ^:private alert-schema
{:event/alert-create (mc/schema
[:map {:closed true}
[:user-id pos-int?]
[:object [:and
[:fn #(t2/instance-of? :model/Pulse %)]
[:map
[:card [:fn #(t2/instance-of? :model/Card %)]]]]]])}) |
pulse schemas | (def ^:private pulse-schemas
{:event/pulse-create (mc/schema
[:map {:closed true}
[:user-id pos-int?]
[:object [:fn #(t2/instance-of? :model/Pulse %)]]])}) |
table events | |
(def ^:private table-events
{:event/table-read (mc/schema
[:map {:closed true}
[:user-id pos-int?]
[:object [:fn #(t2/instance-of? :model/Table %)]]])}) | |
(let [default-schema (mc/schema
[:map {:closed true}
[:user-id [:maybe pos-int?]]
[:object [:maybe [:fn #(boolean (t2/model %))]]]
[:has-access {:optional true} [:maybe :boolean]]])]
(def ^:private permission-failure-events
{:event/read-permission-failure default-schema
:event/write-permission-failure default-schema
:event/update-permission-failure default-schema
:event/create-permission-failure (mc/schema
[:map {:closed true}
[:user-id [:maybe pos-int?]]
[:model [:or :keyword :string]]])})) | |
Returns the schema for an event topic. | (def topic->schema
(merge dashboard-events-schemas
card-events-schemas
user-events-schema
metric-related-schema
segment-related-schema
database-events
alert-schema
pulse-schemas
table-events
permission-failure-events)) |
(ns metabase.events.sync-database (:require [metabase.events :as events] [metabase.sync :as sync] [metabase.sync.sync-metadata :as sync-metadata] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [methodical.core :as methodical])) | |
(derive ::event :metabase/event) (derive :event/database-create ::event) | |
(methodical/defmethod events/publish-event! ::event
[topic {database :object :as _event}]
;; try/catch here to prevent individual topic processing exceptions from bubbling up. better to handle them here.
(try
(when database
;; just kick off a sync on another thread
(future
(try
;; only do the 'full' sync if this is a "full sync" database. Otherwise just do metadata sync only
(if (:is_full_sync database)
(sync/sync-database! database)
(sync-metadata/sync-db-metadata! database))
(catch Throwable e
(log/error e (trs "Error syncing Database {0}" (u/the-id database)))))))
(catch Throwable e
(log/warnf e "Failed to process sync-database event: %s" topic)))) | |
This namespace is responsible for subscribing to events which should update the view log. | (ns metabase.events.view-log (:require [metabase.api.common :as api] [metabase.events :as events] [metabase.models.audit-log :as audit-log] [metabase.models.query.permissions :as query-perms] [metabase.util :as u] [metabase.util.log :as log] [methodical.core :as m] [steffan-westcott.clj-otel.api.trace.span :as span] [toucan2.core :as t2])) |
Simple base function for recording a view of a given | (defn- record-views!
[view-or-views]
(span/with-span!
{:name "record-view!"}
(t2/insert! :model/ViewLog view-or-views))) |
Generates a view, given an event map. | (defn- generate-view
[{:keys [object user-id has-access]
:or {has-access true}}]
{:model (u/lower-case-en (audit-log/model-name object))
:user_id (or user-id api/*current-user-id*)
:model_id (u/id object)
:has_access has-access}) |
(derive ::card-read-event :metabase/event) (derive :event/card-read ::card-read-event) | |
(m/defmethod events/publish-event! ::card-read-event
"Handle processing for a generic read event notification"
[topic event]
(span/with-span!
{:name "view-log-card-read"
:topic topic
:user-id (:user-id event)}
(try
(-> event
generate-view
(assoc :context "question")
record-views!)
(catch Throwable e
(log/warnf e "Failed to process view_log event. %s" topic))))) | |
(derive ::read-permission-failure :metabase/event) (derive :event/read-permission-failure ::read-permission-failure) | |
(m/defmethod events/publish-event! ::read-permission-failure
"Handle processing for a generic read event notification"
[topic {:keys [object] :as event}]
(try
;; Only log permission check failures for Cards and Dashboards. This set can be expanded if we add view logging of
;; other models.
(when (#{:model/Card :model/Dashboard} (t2/model object))
(-> event
generate-view
record-views!))
(catch Throwable e
(log/warnf e "Failed to process view_log event. %s" topic)))) | |
(derive ::dashboard-read :metabase/event) (derive :event/dashboard-read ::dashboard-read) | |
Returns true if the dashcard's card was readable by the current user, and false otherwise. Unreadable cards are replaced with maps containing just the card's ID, so we can check for this to determine whether the card was readable | (defn- readable-dashcard?
[dashcard]
(let [card (:card dashcard)]
(not= (set (keys card)) #{:id}))) |
(m/defmethod events/publish-event! ::dashboard-read
"Handle processing for the dashboard read event. Logs the dashboard view as well as card views for each card on the
dashboard."
[topic {:keys [object user-id] :as event}]
(span/with-span!
{:name "view-log-dashboard-read"
:topic topic
:user-id user-id}
(try
(let [dashcards (filter :card_id (:dashcards object)) ;; filter out link/text cards wtih no card_id
user-id (or user-id api/*current-user-id*)
views (map (fn [dashcard]
{:model "card"
:model_id (u/id (:card_id dashcard))
:user_id user-id
:has_access (readable-dashcard? dashcard)
:context "dashboard"})
dashcards)
dash-view (generate-view event)]
(record-views! (cons dash-view views)))
(catch Throwable e
(log/warnf e "Failed to process view_log event. %s" topic))))) | |
(derive ::table-read :metabase/event) (derive :event/table-read ::table-read) | |
(m/defmethod events/publish-event! ::table-read
"Handle processing for the table read event. Does a basic permissions check to see if the the user has data perms for
the table."
[topic {:keys [object user-id] :as event}]
(span/with-span!
{:name "view-log-table-read"
:topic topic
:user-id user-id}
(try
(let [table-id (u/id object)
database-id (:db_id object)
has-access? (when (= api/*current-user-id* user-id)
(query-perms/can-query-table? database-id table-id))]
(-> event
(assoc :has-access has-access?)
generate-view
record-views!))
(catch Throwable e
(log/warnf e "Failed to process view_log event. %s" topic))))) | |
Provides functions that support formatting results data. In particular, customizing formatting for when timezone, column metadata, and visualization-settings are known. These functions can be used for uniform rendering of all artifacts such as generated CSV or image files that need consistent formatting across the board. | (ns metabase.formatter (:require [clojure.pprint :refer [cl-format]] [clojure.string :as str] [hiccup.util] [metabase.formatter.datetime :as datetime] [metabase.public-settings :as public-settings] [metabase.shared.models.visualization-settings :as mb.viz] [metabase.shared.util.currency :as currency] [metabase.types :as types] [metabase.util.ui-logic :as ui-logic] [potemkin.types :as p.types] [schema.core :as s]) (:import (java.math RoundingMode) (java.net URL) (java.text DecimalFormat DecimalFormatSymbols))) |
(set! *warn-on-reflection* true) | |
Fool Eastwood into thinking this namespace is used | (comment hiccup.util/keep-me) |
Schema used for functions that operate on pulse card contents and their attachments | (def RenderedPulseCard
{:attachments (s/maybe {s/Str URL})
:content [s/Any]
(s/optional-key :render/text) (s/maybe s/Str)}) |
(p.types/defrecord+ NumericWrapper [^String num-str ^Number num-value] hiccup.util/ToString (to-str [_] num-str) Object (toString [_] num-str)) | |
(defn- strip-trailing-zeroes
[num-as-string decimal]
(if (str/includes? num-as-string (str decimal))
(let [pattern (re-pattern (str/escape (str decimal \$) {\. "\\."}))]
(-> num-as-string
(str/split #"0+$")
first
(str/split pattern)
first))
num-as-string)) | |
(defn- digits-after-decimal
([value] (digits-after-decimal value "."))
([value decimal]
(if (zero? value)
0
(let [val-string (-> (condp = (type value)
java.math.BigDecimal (.toPlainString ^BigDecimal value)
java.lang.Double (format "%.20f" value)
java.lang.Float (format "%.20f" value)
(str value))
(strip-trailing-zeroes (str decimal)))
[_n d] (str/split val-string #"[^\d*]")]
(count d))))) | |
(defn- sig-figs-after-decimal
[value decimal]
(if (zero? value)
0
(let [val-string (-> (condp = (type value)
java.math.BigDecimal (.toPlainString ^BigDecimal value)
java.lang.Double (format "%.20f" value)
java.lang.Float (format "%.20f" value)
(str value))
(strip-trailing-zeroes (str decimal)))
figs (last (str/split val-string #"[\.0]+"))]
(count figs)))) | |
Return a function that will take a number and format it according to its column viz settings. Useful to compute the format string once and then apply it over many values. | (defn number-formatter
[{:keys [semantic_type effective_type base_type]
col-id :id field-ref :field_ref col-name :name :as _column}
viz-settings]
(let [col-id (or col-id (second field-ref))
column-settings (-> (get viz-settings ::mb.viz/column-settings)
(update-keys #(select-keys % [::mb.viz/field-id ::mb.viz/column-name])))
column-settings (or (get column-settings {::mb.viz/field-id col-id})
(get column-settings {::mb.viz/column-name col-name}))
global-settings (::mb.viz/global-column-settings viz-settings)
currency? (boolean (or (= (::mb.viz/number-style column-settings) "currency")
(and (nil? (::mb.viz/number-style column-settings))
(or
(::mb.viz/currency-style column-settings)
(::mb.viz/currency column-settings)))))
{::mb.viz/keys [number-separators decimals scale number-style
prefix suffix currency-style currency]} (merge
(when currency?
(:type/Currency global-settings))
(:type/Number global-settings)
column-settings)
integral? (isa? (or effective_type base_type) :type/Integer)
relation? (isa? semantic_type :Relation/*)
percent? (or (isa? semantic_type :type/Percentage) (= number-style "percent"))
scientific? (= number-style "scientific")
[decimal grouping] (or number-separators
(get-in (public-settings/custom-formatting) [:type/Number :number_separators])
".,")
symbols (doto (DecimalFormatSymbols.)
(cond-> decimal (.setDecimalSeparator decimal))
(cond-> grouping (.setGroupingSeparator grouping)))
base (cond-> (if (or scientific? relation?) "0" "#,##0")
(not grouping) (str/replace #"," ""))]
(fn [value]
(if (number? value)
(let [scaled-value (cond-> (* value (or scale 1))
percent?
(* 100))
decimals-in-value (digits-after-decimal scaled-value)
decimal-digits (cond
decimals decimals ;; if user ever specifies # of decimals, use that
integral? 0
currency? (get-in currency/currency [(keyword (or currency "USD")) :decimal_digits])
percent? (min 2 decimals-in-value) ;; 5.5432 -> %554.32
:else (if (>= scaled-value 1)
(min 2 decimals-in-value) ;; values greater than 1 round to 2 decimal places
(let [n-figs (sig-figs-after-decimal scaled-value decimal)]
(if (> n-figs 2)
(max 2 (- decimals-in-value (- n-figs 2))) ;; values less than 1 round to 2 sig-dig
decimals-in-value))))
fmt-str (cond-> base
(not (zero? decimal-digits)) (str "." (apply str (repeat decimal-digits "0")))
scientific? (str "E0"))
fmtr (doto (DecimalFormat. fmt-str symbols) (.setRoundingMode RoundingMode/HALF_UP))]
(map->NumericWrapper
{:num-value value
:num-str (let [inline-currency? (and currency?
(false? (::mb.viz/currency-in-header column-settings)))]
(str (when prefix prefix)
(when (and inline-currency? (or (nil? currency-style)
(= currency-style "symbol")))
(get-in currency/currency [(keyword (or currency "USD")) :symbol]))
(when (and inline-currency? (= currency-style "code"))
(str (get-in currency/currency [(keyword (or currency "USD")) :code]) \space))
(cond-> (.format fmtr scaled-value)
(and (not currency?) (not decimals))
(strip-trailing-zeroes decimal)
percent? (str "%"))
(when (and inline-currency? (= currency-style "name"))
(str \space (get-in currency/currency [(keyword (or currency "USD")) :name_plural])))
(when suffix suffix)))}))
value)))) |
(s/defn format-number :- NumericWrapper
"Format a number `n` and return it as a NumericWrapper; this type is used to do special formatting in other
`pulse.render` namespaces."
([n :- s/Num]
(map->NumericWrapper {:num-str (cl-format nil (if (integer? n) "~:d" "~,2f") n)
:num-value n}))
([value column viz-settings]
(let [fmttr (number-formatter column viz-settings)]
(fmttr value)))) | |
Return a pair of | (defn graphing-column-row-fns
[card data]
[(or (ui-logic/x-axis-rowfn card data)
first)
(or (ui-logic/y-axis-rowfn card data)
second)]) |
Graal polyglot system (not the JS machine itself, the polyglot system) is not happy with BigInts or BigDecimals. For more information, this is the GraalVM issue, open a while https://github.com/oracle/graal/issues/2737 Because of this unfortunately they all have to get smushed into normal ints and decimals in JS land. | (defn coerce-bignum-to-int
[row]
(for [member row]
(cond
;; this returns true for bigint only, not normal int or long
(instance? clojure.lang.BigInt member)
(int member)
;; this returns true for bigdec only, not actual normal decimals
;; not the clearest clojure native function in the world
(decimal? member)
(double member)
:else
member))) |
Preprocess rows.
| (defn row-preprocess
[x-axis-fn y-axis-fn rows]
(->> rows
(filter (every-pred x-axis-fn y-axis-fn))
(map coerce-bignum-to-int))) |
Create a formatter for a column based on its timezone, column metadata, and visualization-settings | (s/defn create-formatter
[timezone-id :- (s/maybe s/Str) col visualization-settings]
(cond
;; for numbers, return a format function that has already computed the differences.
;; todo: do the same for temporal strings
(types/temporal-field? col)
#(datetime/format-temporal-str timezone-id % col visualization-settings)
;; todo integer columns with a unit
(or (isa? (:effective_type col) :type/Number)
(isa? (:base_type col) :type/Number))
(number-formatter col visualization-settings)
:else
str)) |
Logic for rendering datetimes when context such as timezone, column metadata, and visualization settings are known. | (ns metabase.formatter.datetime (:require [clojure.string :as str] [java-time.api :as t] [metabase.public-settings :as public-settings] [metabase.query-processor.streaming.common :as common] [metabase.shared.formatting.constants :as constants] [metabase.shared.models.visualization-settings :as mb.viz] [metabase.util.date-2 :as u.date] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log]) (:import (com.ibm.icu.text RuleBasedNumberFormat) (java.util Locale))) |
(set! *warn-on-reflection* true) | |
Returns
| (defn temporal-string?
[s]
(boolean
(try
(u.date/parse s)
(catch Exception _e false)))) |
(defn- reformat-temporal-str [timezone-id s new-format-string] (t/format new-format-string (u.date/parse s timezone-id))) | |
(defn- day-of-week
[n abbreviate]
(let [fmtr (java.time.format.DateTimeFormatter/ofPattern (if abbreviate "EEE" "EEEE"))]
(.format fmtr (java.time.DayOfWeek/of n)))) | |
(defn- month-of-year
[n abbreviate]
(let [fmtr (java.time.format.DateTimeFormatter/ofPattern (if abbreviate "MMM" "MMMM"))]
(.format fmtr (java.time.Month/of n)))) | |
Format an integer as x-th of y, for example, 2nd week of year. | (defn- x-of-y
[n]
(let [nf (RuleBasedNumberFormat. (Locale. (public-settings/site-locale)) RuleBasedNumberFormat/ORDINAL)]
(.format nf n))) |
(defn- hour-of-day
[s time-style]
(let [n (parse-long s)
ts (u.date/parse "2022-01-01-00:00:00")]
(u.date/format time-style (t/plus ts (t/hours n))))) | |
Get the column-settings map for the given column from the viz-settings. | (defn- viz-settings-for-col
[{column-name :name :keys [field_ref]} viz-settings]
(let [[_ field-id-or-name] field_ref
all-cols-settings (-> viz-settings
::mb.viz/column-settings
;; update the keys so that they will have only the :field-id or :column-name
;; and not have any metadata. Since we don't know the metadata, we can never
;; match a key with metadata, even if we do have the correct name or id
(update-keys #(select-keys % [::mb.viz/field-id ::mb.viz/column-name])))]
(or (all-cols-settings {::mb.viz/field-id field-id-or-name})
(all-cols-settings {::mb.viz/column-name (or field-id-or-name column-name)})))) |
Given viz-settings with a time-style and possible time-enabled (precision) entry, create the format string.
Note that if the | (defn- determine-time-format
[{:keys [time-style] :or {time-style "h:mm A"} :as viz-settings}]
;; NOTE - If :time-enabled is present but nil it will return nil
(when-some [base-time-format (case (get viz-settings :time-enabled "minutes")
"minutes" "mm"
"seconds" "mm:ss"
"milliseconds" "mm:ss.SSS"
nil nil)]
(case time-style
"HH:mm" (format "HH:%s" base-time-format)
;; Deprecated time style which should be already converted to HH:mm when viz settings are
;; normalized, but we'll handle it here too just in case. (#18112)
"k:mm" (str "h" base-time-format)
("h:mm A" "h:mm a") (format "h:%s a" base-time-format)
time-style))) |
The Java pattern for DateTimeFormatter is | (defn- fix-time-style [time-style default-time-style] (str/replace (or time-style default-time-style) #"A" "a")) |
Potentially modify a date style to abbreviate names or add a different date separator. | (defn- post-process-date-style
[date-style {:keys [date-abbreviate date-separator]}]
(let [conditional-changes
(cond-> (-> date-style (str/replace #"dddd" "EEEE"))
date-separator (str/replace #"/" date-separator)
date-abbreviate (-> (str/replace #"MMMM" "MMM")
(str/replace #"EEEE" "EEE")
(str/replace #"DDD" "D")))]
(-> conditional-changes
;; 'D' formats as Day of year, we want Day of month, which is 'd' (issue #27469)
(str/replace #"D" "d")))) |
The dispatch function logic for format format-timestring. Find the first of the unit or highest type of the object. | (def ^:private col-type (some-fn :unit :semantic_type :effective_type :base_type)) |
Reformat a temporal literal string to the desired format based on column | (defmulti format-timestring (fn [_timezone-id _temporal-str col _viz-settings] (col-type col))) |
(defmethod format-timestring :minute [timezone-id temporal-str _col {:keys [date-style time-style] :as viz-settings}]
(reformat-temporal-str timezone-id temporal-str
(-> (or date-style "MMMM, yyyy")
(str ", " (fix-time-style time-style constants/default-time-style))
(post-process-date-style viz-settings)))) | |
(defmethod format-timestring :hour [timezone-id temporal-str _col {:keys [date-style time-style] :as viz-settings}]
(reformat-temporal-str timezone-id temporal-str
(-> (or date-style "MMMM, yyyy")
(str ", " (fix-time-style time-style "h a"))
(post-process-date-style viz-settings)))) | |
(defmethod format-timestring :day [timezone-id temporal-str _col {:keys [date-style] :as viz-settings}]
(reformat-temporal-str timezone-id temporal-str
(-> (or date-style "EEEE, MMMM d, YYYY")
(post-process-date-style viz-settings)))) | |
(defmethod format-timestring :week [timezone-id temporal-str _col _viz-settings] (str (tru "Week ") (reformat-temporal-str timezone-id temporal-str "w - YYYY"))) | |
(defmethod format-timestring :month [timezone-id temporal-str _col {:keys [date-style] :as viz-settings}]
(reformat-temporal-str timezone-id temporal-str
(-> (or date-style "MMMM, yyyy")
(post-process-date-style viz-settings)))) | |
(defmethod format-timestring :quarter [timezone-id temporal-str _col _viz-settings] (reformat-temporal-str timezone-id temporal-str "QQQ - yyyy")) | |
(defmethod format-timestring :year [timezone-id temporal-str _col _viz-settings] (reformat-temporal-str timezone-id temporal-str "YYYY")) | |
(defmethod format-timestring :day-of-week [_timezone-id temporal-str _col {:keys [date-abbreviate]}]
(day-of-week (parse-long temporal-str) date-abbreviate)) | |
(defmethod format-timestring :month-of-year [_timezone-id temporal-str _col {:keys [date-abbreviate]}]
(month-of-year (parse-long temporal-str) date-abbreviate)) | |
(defmethod format-timestring :quarter-of-year [_timezone-id temporal-str _col _viz-settings] (format "Q%s" temporal-str)) | |
(defmethod format-timestring :hour-of-day [_timezone-id temporal-str _col {:keys [time-style]}]
(hour-of-day temporal-str (fix-time-style time-style "h a"))) | |
(defmethod format-timestring :week-of-year [_timezone-id temporal-str _col _viz-settings] (x-of-y (parse-long temporal-str))) | |
(defmethod format-timestring :minute-of-hour [_timezone-id temporal-str _col _viz-settings] (x-of-y (parse-long temporal-str))) | |
(defmethod format-timestring :day-of-month [_timezone-id temporal-str _col _viz-settings] (x-of-y (parse-long temporal-str))) | |
(defmethod format-timestring :day-of-year [_timezone-id temporal-str _col _viz-settings] (x-of-y (parse-long temporal-str))) | |
(defmethod format-timestring :type/Time [timezone-id temporal-str _col viz-settings]
(let [time-style (some-> (determine-time-format viz-settings)
(fix-time-style constants/default-time-style))]
;; ATM, the FE can technically say the time style is `nil` via the `:time-enabled` key. While this doesn't really
;; make sense, we should guard against it by returning an empty string if the time style is `nil`.
(if time-style
(reformat-temporal-str timezone-id temporal-str time-style)
""))) | |
(defmethod format-timestring :type/Date [timezone-id temporal-str _col {:keys [date-style] :as viz-settings}]
(let [date-format (post-process-date-style (or date-style "MMMM d, yyyy") viz-settings)]
(reformat-temporal-str timezone-id temporal-str date-format))) | |
(defmethod format-timestring :type/DateTime [timezone-id temporal-str _col {:keys [date-style] :as viz-settings}]
(let [date-style (or date-style "MMMM d, yyyy")
time-style (some-> (determine-time-format viz-settings)
(fix-time-style constants/default-time-style))
date-time-style (cond-> date-style
time-style
(str ", " time-style))
default-format-string (post-process-date-style date-time-style viz-settings)]
(t/format default-format-string (u.date/parse temporal-str timezone-id)))) | |
(defmethod format-timestring :default [timezone-id temporal-str {:keys [unit] :as col} {:keys [date-style] :as viz-settings}]
(if (= :default unit)
;; When the unit is the `:default` literal we want to retry formatting with the data types contained in col.
(format-timestring timezone-id temporal-str (dissoc col :unit) viz-settings)
;; We're making an assumption when we bottom out here that the string is compatible with this default format,
;; 'MMMM d, yyyy'. If the time string isn't compatible with this format, we just return the string.
;; This is not likely to happen IRL since you generally have a useful unit or know the type of the colum. A failure
;; mode that can be reproduced in test is trying to format a time string (e.g.'15:30:45Z') when the column has no
;; type information (e.g. a semantic or effective type of `:type/Time`).
(let [date-format (post-process-date-style (or date-style "MMMM d, yyyy") viz-settings)]
(try
(reformat-temporal-str timezone-id temporal-str date-format)
(catch Exception _
(log/warnf "Could not format temporal string %s in time zone %s with format %s."
temporal-str
timezone-id
date-format)
temporal-str))))) | |
Reformat a temporal literal string by combining time zone, column, and viz setting information to create a final desired output format. | (defn format-temporal-str
([timezone-id temporal-str col] (format-temporal-str timezone-id temporal-str col {}))
([timezone-id temporal-str col viz-settings]
(Locale/setDefault (Locale. (public-settings/site-locale)))
(let [merged-viz-settings (common/normalize-keys
(common/viz-settings-for-col col viz-settings))]
(if (str/blank? temporal-str)
""
(format-timestring timezone-id temporal-str col merged-viz-settings))))) |
Shared functionality used by different integrations. | (ns metabase.integrations.common
(:require
[clojure.data :as data]
[clojure.set :as set]
[metabase.models.permissions-group :as perms-group]
[metabase.models.permissions-group-membership
:as perms-group-membership
:refer [PermissionsGroupMembership]]
[metabase.models.setting.multi-setting :refer [define-multi-setting
define-multi-setting-impl]]
[metabase.public-settings.premium-features :as premium-features]
[metabase.util :as u]
[metabase.util.i18n :refer [deferred-tru
trs]]
[metabase.util.log :as log]
[toucan2.core :as t2])) |
Update the PermissionsGroups a User belongs to, adding or deleting membership entries as needed so that Users is
only in | (defn sync-group-memberships!
[user-or-id new-groups-or-ids mapped-groups-or-ids]
(let [mapped-group-ids (set (map u/the-id mapped-groups-or-ids))
excluded-group-ids #{(u/the-id (perms-group/all-users))}
user-id (u/the-id user-or-id)
current-group-ids (when (seq mapped-group-ids)
(t2/select-fn-set :group_id PermissionsGroupMembership
{:where
[:and
[:= :user_id user-id]
[:in :group_id mapped-group-ids]
[:not-in :group_id excluded-group-ids]]}))
new-group-ids (set/intersection (set (map u/the-id new-groups-or-ids))
mapped-group-ids)
;; determine what's different between current mapped groups and new mapped groups
[to-remove to-add] (data/diff current-group-ids new-group-ids)]
;; remove membership from any groups as needed
(when (seq to-remove)
(log/debugf "Removing user %s from group(s) %s" user-id to-remove)
(try
(t2/delete! PermissionsGroupMembership :group_id [:in to-remove], :user_id user-id)
(catch clojure.lang.ExceptionInfo e
;; in case sync attempts to delete the last admin, the pre-delete hooks of
;; [[metabase.models.permissions-group-membership/PermissionsGroupMembership]] will throw an exception.
;; but we don't want to block user from logging-in, so catch this exception and log a warning
(if (= (ex-message e) (str perms-group-membership/fail-to-remove-last-admin-msg))
(log/warn "Attempted to remove the last admin during group sync!"
"Check your SSO group mappings and make sure the Administrators group is mapped correctly.")
(throw e)))))
;; add new memberships for any groups as needed
(doseq [id to-add
:when (not (excluded-group-ids id))]
(log/debugf "Adding user %s to group %s" user-id id)
;; if adding membership fails for one reason or another (i.e. if the group doesn't exist) log the error add the
;; user to the other groups rather than failing entirely
(try
(t2/insert! PermissionsGroupMembership :group_id id, :user_id user-id)
(catch Throwable e
(log/error e (trs "Error adding User {0} to Group {1}" user-id id))))))) |
(define-multi-setting send-new-sso-user-admin-email?
(deferred-tru "Should new email notifications be sent to admins, for all new SSO users?")
(fn [] (if (premium-features/enable-any-sso?)
:ee
:oss))) | |
(define-multi-setting-impl send-new-sso-user-admin-email? :oss :getter (fn [] (constantly true)) :setter :none) | |
(ns metabase.integrations.google
(:require
[cheshire.core :as json]
[clj-http.client :as http]
[clojure.string :as str]
[metabase.api.common :as api]
[metabase.config :as config]
[metabase.integrations.google.interface :as google.i]
[metabase.models.interface :as mi]
[metabase.models.setting :as setting :refer [defsetting]]
[metabase.models.setting.multi-setting
:refer [define-multi-setting-impl]]
[metabase.models.user :as user :refer [User]]
[metabase.plugins.classloader :as classloader]
[metabase.util :as u]
[metabase.util.i18n :refer [deferred-tru trs tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[toucan2.core :as t2])) | |
Load EE implementation if available | (when config/ee-available? (classloader/require 'metabase-enterprise.enhancements.integrations.google)) |
(def ^:private non-existant-account-message (deferred-tru "You'll need an administrator to create a Metabase account before you can use Google to log in.")) | |
(defsetting google-auth-client-id
(deferred-tru "Client ID for Google Sign-In.")
:visibility :public
:audit :getter
:setter (fn [client-id]
(if (seq client-id)
(let [trimmed-client-id (str/trim client-id)]
(when-not (str/ends-with? trimmed-client-id ".apps.googleusercontent.com")
(throw (ex-info (tru "Invalid Google Sign-In Client ID: must end with \".apps.googleusercontent.com\)
{:status-code 400})))
(setting/set-value-of-type! :string :google-auth-client-id trimmed-client-id))
(do
(setting/set-value-of-type! :string :google-auth-client-id nil)
(setting/set-value-of-type! :boolean :google-auth-enabled false))))) | |
(defsetting google-auth-configured (deferred-tru "Is Google Sign-In configured?") :type :boolean :setter :none :getter (fn [] (boolean (google-auth-client-id)))) | |
(defsetting google-auth-enabled
(deferred-tru "Is Google Sign-in currently enabled?")
:visibility :public
:type :boolean
:audit :getter
:getter (fn []
(if-some [value (setting/get-value-of-type :boolean :google-auth-enabled)]
value
(boolean (google-auth-client-id))))
:setter (fn [new-value]
(if-let [new-value (boolean new-value)]
(if-not (google-auth-client-id)
(throw (ex-info (tru "Google Sign-In is not configured. Please set the Client ID first.")
{:status-code 400}))
(setting/set-value-of-type! :boolean :google-auth-enabled new-value))
(setting/set-value-of-type! :boolean :google-auth-enabled new-value)))) | |
(define-multi-setting-impl google.i/google-auth-auto-create-accounts-domain :oss
:getter (fn [] (setting/get-value-of-type :string :google-auth-auto-create-accounts-domain))
:setter (fn [domain]
(when (and domain (str/includes? domain ","))
;; Multiple comma-separated domains requires the `:sso-google` premium feature flag
(throw (ex-info (tru "Invalid domain") {:status-code 400})))
(setting/set-value-of-type! :string :google-auth-auto-create-accounts-domain domain))) | |
(def ^:private google-auth-token-info-url "https://www.googleapis.com/oauth2/v3/tokeninfo?id_token=%s") | |
(defn- google-auth-token-info
([token-info-response]
(google-auth-token-info token-info-response (google-auth-client-id)))
([token-info-response client-id]
(let [{:keys [status body]} token-info-response]
(when-not (= status 200)
(throw (ex-info (tru "Invalid Google Sign-In token.") {:status-code 400})))
(u/prog1 (json/parse-string body keyword)
(let [audience (:aud <>)
audience (if (string? audience) [audience] audience)]
(when-not (contains? (set audience) client-id)
(throw (ex-info (tru
(str "Google Sign-In token appears to be incorrect. "
"Double check that it matches in Google and Metabase."))
{:status-code 400}))))
(when-not (= (:email_verified <>) "true")
(throw (ex-info (tru "Email is not verified.") {:status-code 400}))))))) | |
(defn- autocreate-user-allowed-for-email? [email]
(boolean
(when-let [domains (google.i/google-auth-auto-create-accounts-domain)]
(some
(partial u/email-in-domain? email)
(str/split domains #"\s*,\s*"))))) | |
Throws if an admin needs to intervene in the account creation. | (defn- check-autocreate-user-allowed-for-email
[email]
(when-not (autocreate-user-allowed-for-email? email)
(throw
(ex-info (str non-existant-account-message)
{:status-code 401
:errors {:_error non-existant-account-message}})))) |
(mu/defn ^:private google-auth-create-new-user!
[{:keys [email] :as new-user} :- user/NewUser]
(check-autocreate-user-allowed-for-email email)
;; this will just give the user a random password; they can go reset it if they ever change their mind and want to
;; log in without Google Auth; this lets us keep the NOT NULL constraints on password / salt without having to make
;; things hairy and only enforce those for non-Google Auth users
(user/create-new-google-auth-user! new-user)) | |
Update google user if the first or list name changed. | (defn- maybe-update-google-user!
[user first-name last-name]
(when (or (not= first-name (:first_name user))
(not= last-name (:last_name user)))
(t2/update! :model/User (:id user) {:first_name first-name
:last_name last-name}))
(assoc user :first_name first-name :last_name last-name)) |
(mu/defn ^:private google-auth-fetch-or-create-user! :- (mi/InstanceOf User)
[first-name last-name email]
(let [existing-user (t2/select-one [User :id :email :last_login :first_name :last_name] :%lower.email (u/lower-case-en email))]
(if existing-user
(maybe-update-google-user! existing-user first-name last-name)
(google-auth-create-new-user! {:first_name first-name
:last_name last-name
:email email})))) | |
Call to Google to perform an authentication | (defn do-google-auth
[{{:keys [token]} :body, :as _request}]
(let [token-info-response (http/post (format google-auth-token-info-url token))
{:keys [given_name family_name email]} (google-auth-token-info token-info-response)]
(log/info (trs "Successfully authenticated Google Sign-In token for: {0} {1}" given_name family_name))
(api/check-500 (google-auth-fetch-or-create-user! given_name family_name email)))) |
(ns metabase.integrations.google.interface (:require [metabase.models.setting.multi-setting :refer [define-multi-setting]] [metabase.public-settings.premium-features :as premium-features] [metabase.util.i18n :refer [deferred-tru]])) | |
#_{:clj-kondo/ignore [:missing-docstring]}
(define-multi-setting google-auth-auto-create-accounts-domain
(deferred-tru "When set, allow users to sign up on their own if their Google account email address is from this domain.")
(fn [] (if (premium-features/enable-sso-google?) :ee :oss))) | |
(ns metabase.integrations.ldap (:require [cheshire.core :as json] [clj-ldap.client :as ldap] [metabase.config :as config] [metabase.integrations.ldap.default-implementation :as default-impl] [metabase.models.setting :as setting :refer [defsetting]] [metabase.models.user :refer [User]] [metabase.plugins.classloader :as classloader] [metabase.util :as u] [metabase.util.i18n :refer [deferred-tru tru]] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms]) (:import (com.unboundid.ldap.sdk DN LDAPConnectionPool LDAPException))) | |
(set! *warn-on-reflection* true) | |
Load the EE namespace up front so that the extra Settings it defines are available immediately.
Otherwise, this would only happen the first time | (when config/ee-available? (classloader/require 'metabase-enterprise.enhancements.integrations.ldap)) |
(defsetting ldap-host (deferred-tru "Server hostname.") :audit :getter) | |
(defsetting ldap-port (deferred-tru "Server port, usually 389 or 636 if SSL is used.") :type :integer :default 389 :audit :getter) | |
(defsetting ldap-security
(deferred-tru "Use SSL, TLS or plain text.")
:type :keyword
:default :none
:audit :raw-value
:setter (fn [new-value]
(when (some? new-value)
(assert (#{:none :ssl :starttls} (keyword new-value))))
(setting/set-value-of-type! :keyword :ldap-security new-value))) | |
(defsetting ldap-bind-dn (deferred-tru "The Distinguished Name to bind as (if any), this user will be used to lookup information about other users.") :audit :getter) | |
(defsetting ldap-password (deferred-tru "The password to bind with for the lookup user.") :sensitive? true :audit :getter) | |
(defsetting ldap-user-base (deferred-tru "Search base for users. (Will be searched recursively)") :audit :getter) | |
(defsetting ldap-user-filter
(deferred-tru "User lookup filter. The placeholder '{login}' will be replaced by the user supplied login.")
:default "(&(objectClass=inetOrgPerson)(|(uid={login})(mail={login})))"
:audit :getter) | |
(defsetting ldap-attribute-email (deferred-tru "Attribute to use for the user''s email. (usually ''mail'', ''email'' or ''userPrincipalName'')") :default "mail" :getter (fn [] (u/lower-case-en (setting/get-value-of-type :string :ldap-attribute-email))) :audit :getter) | |
(defsetting ldap-attribute-firstname (deferred-tru "Attribute to use for the user''s first name. (usually ''givenName'')") :default "givenName" :getter (fn [] (u/lower-case-en (setting/get-value-of-type :string :ldap-attribute-firstname))) :audit :getter) | |
(defsetting ldap-attribute-lastname (deferred-tru "Attribute to use for the user''s last name. (usually ''sn'')") :default "sn" :getter (fn [] (u/lower-case-en (setting/get-value-of-type :string :ldap-attribute-lastname))) :audit :getter) | |
(defsetting ldap-group-sync (deferred-tru "Enable group membership synchronization with LDAP.") :type :boolean :default false :audit :getter) | |
(defsetting ldap-group-base (deferred-tru "Search base for groups. Not required for LDAP directories that provide a ''memberOf'' overlay, such as Active Directory. (Will be searched recursively)") :audit :getter) | |
(defsetting ldap-group-mappings
;; Should be in the form: {"cn=Some Group,dc=...": [1, 2, 3]} where keys are LDAP group DNs and values are lists of
;; MB groups IDs
(deferred-tru "JSON containing LDAP to Metabase group mappings.")
:type :json
:cache? false
:default {}
:audit :getter
:getter (fn []
(json/parse-string (setting/get-value-of-type :string :ldap-group-mappings) #(DN. (str %))))
:setter (fn [new-value]
(cond
(string? new-value)
(recur (json/parse-string new-value))
(map? new-value)
(do (doseq [k (keys new-value)]
(when-not (DN/isValidDN (u/qualified-name k))
(throw (IllegalArgumentException. (tru "{0} is not a valid DN." (u/qualified-name k))))))
(setting/set-value-of-type! :json :ldap-group-mappings new-value))))) | |
(defsetting ldap-configured?
(deferred-tru "Have the mandatory LDAP settings (host and user search base) been validated and saved?")
:type :boolean
:visibility :public
:setter :none
:getter (fn [] (boolean (and (ldap-host)
(ldap-user-base))))
:doc false) | |
Mappings from Metabase setting names to keys to use for LDAP connections | (def mb-settings->ldap-details
{:ldap-host :host
:ldap-port :port
:ldap-bind-dn :bind-dn
:ldap-password :password
:ldap-security :security
:ldap-user-base :user-base
:ldap-user-filter :user-filter
:ldap-attribute-email :attribute-email
:ldap-attribute-firstname :attribute-firstname
:ldap-attribute-lastname :attribute-lastname
:ldap-group-sync :group-sync
:ldap-group-base :group-base}) |
(defn- details->ldap-options [{:keys [host port bind-dn password security]}]
(let [security (keyword security)
port (if (string? port)
(Integer/parseInt port)
port)]
;; Connecting via IPv6 requires us to use this form for :host, otherwise
;; clj-ldap will find the first : and treat it as an IPv4 and port number
{:host {:address host
:port port}
:bind-dn bind-dn
:password password
:ssl? (= security :ssl)
:startTLS? (= security :starttls)})) | |
(defn- settings->ldap-options []
(details->ldap-options {:host (ldap-host)
:port (ldap-port)
:bind-dn (ldap-bind-dn)
:password (ldap-password)
:security (ldap-security)})) | |
Connects to LDAP with the currently set settings and returns the connection. | (defn- get-connection ^LDAPConnectionPool [] (ldap/connect (settings->ldap-options))) |
Impl for [[with-ldap-connection]] macro. | (defn do-with-ldap-connection
[f]
(with-open [conn (get-connection)]
(f conn))) |
Execute | (defmacro with-ldap-connection
[[connection-binding] & body]
`(do-with-ldap-connection (fn [~(vary-meta connection-binding assoc :tag `LDAPConnectionPool)]
~@body))) |
TODO -- the usage of | (def ^:private user-base-error {:status :ERROR, :message "User search base does not exist or is unreadable"})
(def ^:private group-base-error {:status :ERROR, :message "Group search base does not exist or is unreadable"}) |
Test the connection to an LDAP server to determine if we can find the search base. Takes in a dictionary of properties such as: {:host "localhost" :port 389 :bind-dn "cn=Directory Manager" :password "password" :security "none" :user-base "ou=Birds,dc=metabase,dc=com" :group-base "ou=Groups,dc=metabase,dc=com"} | (defn test-ldap-connection
[{:keys [user-base group-base], :as details}]
(try
(with-open [^LDAPConnectionPool conn (ldap/connect (details->ldap-options details))]
(or
(try
(when-not (ldap/get conn user-base)
user-base-error)
(catch Exception _e
user-base-error))
(when group-base
(try
(when-not (ldap/get conn group-base)
group-base-error)
(catch Exception _e
group-base-error)))
{:status :SUCCESS}))
(catch LDAPException e
{:status :ERROR, :message (.getMessage e), :code (.getResultCode e)})
(catch Exception e
{:status :ERROR, :message (.getMessage e)}))) |
Tests the connection to an LDAP server using the currently set settings. | (defn test-current-ldap-details
[]
(let [settings (into {} (for [[k v] mb-settings->ldap-details]
[v (setting/get k)]))]
(test-ldap-connection settings))) |
Verifies if the supplied password is valid for the | (defn verify-password
([user-info password]
(with-ldap-connection [conn]
(verify-password conn user-info password)))
([conn user-info password]
(let [dn (if (string? user-info) user-info (:dn user-info))]
(ldap/bind? conn dn password)))) |
A map of all ldap settings | (defn ldap-settings
[]
{:first-name-attribute (ldap-attribute-firstname)
:last-name-attribute (ldap-attribute-lastname)
:email-attribute (ldap-attribute-email)
:sync-groups? (ldap-group-sync)
:user-base (ldap-user-base)
:user-filter (ldap-user-filter)
:group-base (ldap-group-base)
:group-mappings (ldap-group-mappings)}) |
(mu/defn find-user :- [:maybe default-impl/UserInfo]
"Get user information for the supplied username."
([username :- ms/NonBlankString]
(with-ldap-connection [conn]
(find-user conn username)))
([ldap-connection :- (ms/InstanceOfClass LDAPConnectionPool)
username :- ms/NonBlankString]
(default-impl/find-user ldap-connection username (ldap-settings)))) | |
(mu/defn fetch-or-create-user! :- (ms/InstanceOf User) "Using the `user-info` (from [[find-user]]) get the corresponding Metabase user, creating it if necessary." [user-info :- default-impl/UserInfo] (default-impl/fetch-or-create-user! user-info (ldap-settings))) | |
Default LDAP integration. This integration is used by OSS or for EE if enterprise features are not enabled. | (ns metabase.integrations.ldap.default-implementation (:require [clj-ldap.client :as ldap] [clojure.string :as str] [metabase.integrations.common :as integrations.common] [metabase.models.user :as user :refer [User]] [metabase.public-settings.premium-features :refer [defenterprise-schema]] [metabase.util :as u] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2]) (:import (com.unboundid.ldap.sdk DN Filter LDAPConnectionPool))) |
(set! *warn-on-reflection* true) | |
Schema for LDAP User info as returned by | (def UserInfo [:map [:dn ms/NonBlankString] [:first-name [:maybe ms/NonBlankString]] [:last-name [:maybe ms/NonBlankString]] [:email ms/Email] [:groups [:maybe [:sequential ms/NonBlankString]]]]) |
Options passed to LDAP integration implementations. These are just the various LDAP Settings from
| (def LDAPSettings [:map [:first-name-attribute ms/NonBlankString] [:last-name-attribute ms/NonBlankString] [:email-attribute ms/NonBlankString] [:sync-groups? :boolean] [:user-base ms/NonBlankString] [:user-filter ms/NonBlankString] [:group-base [:maybe ms/NonBlankString]] [:group-mappings [:maybe [:map-of (ms/InstanceOfClass DN) [:sequential ms/PositiveInt]]]]]) |
--------------------------------------------------- find-user ---------------------------------------------------- | |
(def ^:private filter-placeholder
"{login}") | |
(def ^:private group-membership-filter
"(member={dn})") | |
(mu/defn search :- [:maybe :map]
"Search for a LDAP user with `username`."
[ldap-connection :- (ms/InstanceOfClass LDAPConnectionPool)
username :- ms/NonBlankString
{:keys [user-base user-filter]} :- LDAPSettings]
(some-> (first
(ldap/search
ldap-connection
user-base
{:scope :sub
:filter (str/replace user-filter filter-placeholder (Filter/encodeValue ^String username))
:size-limit 1}))
u/lower-case-map-keys)) | |
(mu/defn ^:private process-group-membership-filter :- ms/NonBlankString
"Replace DN and UID placeholders with values returned by the LDAP server."
[group-membership-filter :- ms/NonBlankString
dn :- ms/NonBlankString
uid :- [:maybe ms/NonBlankString]]
(let [uid-string (or uid )]
(-> group-membership-filter
(str/replace "{dn}" (Filter/encodeValue ^String dn))
(str/replace "{uid}" (Filter/encodeValue ^String uid-string))))) | |
(mu/defn ^:private user-groups :- [:maybe [:sequential ms/NonBlankString]]
"Retrieve groups for a supplied DN."
[ldap-connection :- (ms/InstanceOfClass LDAPConnectionPool)
dn :- ms/NonBlankString
uid :- [:maybe ms/NonBlankString]
{:keys [group-base]} :- LDAPSettings
group-membership-filter :- ms/NonBlankString]
(when group-base
(let [results (ldap/search
ldap-connection
group-base
{:scope :sub
:filter (process-group-membership-filter group-membership-filter dn uid)})]
(map :dn results)))) | |
(mu/defn ldap-search-result->user-info :- [:maybe UserInfo]
"Convert the result "
[ldap-connection :- (ms/InstanceOfClass LDAPConnectionPool)
{:keys [dn uid], :as result} :- :map
{:keys [first-name-attribute
last-name-attribute
email-attribute
sync-groups?]
:as settings} :- LDAPSettings
group-membership-filter :- ms/NonBlankString]
(let [{first-name (keyword first-name-attribute)
last-name (keyword last-name-attribute)
email (keyword email-attribute)} result]
{:dn dn
:first-name first-name
:last-name last-name
:email email
:groups (when sync-groups?
;; Active Directory and others (like FreeIPA) will supply a `memberOf` overlay attribute for
;; groups. Otherwise we have to make the inverse query to get them.
(or (u/one-or-many (:memberof result))
(user-groups ldap-connection dn uid settings group-membership-filter)
[]))})) | |
(defenterprise-schema find-user :- [:maybe UserInfo]
"Get user information for the supplied username."
metabase-enterprise.enhancements.integrations.ldap
[ldap-connection :- (ms/InstanceOfClass LDAPConnectionPool)
username :- ms/NonBlankString
settings :- LDAPSettings]
(when-let [result (search ldap-connection username settings)]
(ldap-search-result->user-info ldap-connection result settings group-membership-filter))) | |
--------------------------------------------- fetch-or-create-user! ---------------------------------------------- | |
(mu/defn ldap-groups->mb-group-ids :- [:set ms/PositiveInt]
"Translate a set of a user's group DNs to a set of MB group IDs using the configured mappings."
[ldap-groups :- [:maybe [:sequential ms/NonBlankString]]
{:keys [group-mappings]} :- [:select-keys LDAPSettings [:group-mappings]]]
(-> group-mappings
(select-keys (map #(DN. (str %)) ldap-groups))
vals
flatten
set)) | |
(mu/defn all-mapped-group-ids :- [:set ms/PositiveInt]
"Returns the set of all MB group IDs that have configured mappings."
[{:keys [group-mappings]} :- [:select-keys LDAPSettings [:group-mappings]]]
(-> group-mappings
vals
flatten
set)) | |
(defenterprise-schema fetch-or-create-user! :- (ms/InstanceOf User)
"Using the `user-info` (from `find-user`) get the corresponding Metabase user, creating it if necessary."
metabase-enterprise.enhancements.integrations.ldap
[{:keys [first-name last-name email groups]} :- UserInfo
{:keys [sync-groups?], :as settings} :- LDAPSettings]
(let [user (t2/select-one [User :id :last_login :first_name :last_name :is_active]
:%lower.email (u/lower-case-en email))
new-user (if user
(let [old-first-name (:first_name user)
old-last-name (:last_name user)
user-changes (merge
(when (not= first-name old-first-name) {:first_name first-name})
(when (not= last-name old-last-name) {:last_name last-name}))]
(if (seq user-changes)
(do
(t2/update! User (:id user) user-changes)
(t2/select-one [User :id :last_login :is_active] :id (:id user))) ; Reload updated user
user))
(-> (user/create-new-ldap-auth-user! {:first_name first-name
:last_name last-name
:email email})
(assoc :is_active true)))]
(u/prog1 new-user
(when sync-groups?
(let [group-ids (ldap-groups->mb-group-ids groups settings)
all-mapped-group-ids (all-mapped-group-ids settings)]
(integrations.common/sync-group-memberships! new-user group-ids all-mapped-group-ids)))))) | |
(ns metabase.integrations.slack (:require [cheshire.core :as json] [clj-http.client :as http] [clojure.java.io :as io] [clojure.string :as str] [java-time.api :as t] [medley.core :as m] [metabase.email.messages :as messages] [metabase.models.setting :as setting :refer [defsetting]] [metabase.util :as u] [metabase.util.date-2 :as u.date] [metabase.util.i18n :refer [deferred-tru trs tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [metabase.util.string :as u.str])) | |
(set! *warn-on-reflection* true) | |
(defsetting slack-token
(deferred-tru
(str "Deprecated Slack API token for connecting the Metabase Slack bot. "
"Please use a new Slack app integration instead."))
:deprecated "0.42.0"
:visibility :settings-manager
:doc false
:audit :never) | |
(defsetting slack-app-token
(deferred-tru
(str "Bot user OAuth token for connecting the Metabase Slack app. "
"This should be used for all new Slack integrations starting in Metabase v0.42.0."))
:visibility :settings-manager
:getter (fn []
(-> (setting/get-value-of-type :string :slack-app-token)
(u.str/mask 9)))) | |
(defn- unobfuscated-slack-app-token [] (setting/get-value-of-type :string :slack-app-token)) | |
(defsetting slack-token-valid?
(deferred-tru
(str "Whether the current Slack app token, if set, is valid. "
"Set to 'false' if a Slack API request returns an auth error."))
:type :boolean
:visibility :settings-manager
:doc false
:audit :never) | |
Converts empty strings to | (defn process-files-channel-name
[channel-name]
(when-not (str/blank? channel-name)
(if (str/starts-with? channel-name "#") (subs channel-name 1) channel-name))) |
A cache shared between instances for storing an instance's slack channels and users. | (defsetting slack-cached-channels-and-usernames :visibility :internal :type :json :doc false :audit :never) |
(def ^:private zoned-time-epoch (t/zoned-date-time 1970 1 1 0)) | |
The updated-at time for the [[slack-cached-channels-and-usernames]] setting. | (defsetting slack-channels-and-usernames-last-updated :visibility :internal :cache? false :type :timestamp :default zoned-time-epoch :doc false :audit :never) |
(defsetting slack-files-channel
(deferred-tru "The name of the channel to which Metabase files should be initially uploaded")
:default "metabase_files"
:visibility :settings-manager
:audit :getter
:setter (fn [channel-name]
(setting/set-value-of-type! :string :slack-files-channel (process-files-channel-name channel-name)))) | |
Is Slack integration configured? | (defn slack-configured? [] (boolean (or (seq (slack-app-token)) (seq (slack-token))))) |
List of error codes that indicate an invalid or revoked Slack token. | (def ^:private slack-token-error-codes
;; If any of these error codes are received from the Slack API, we send an email to all admins indicating that the
;; Slack integration is broken. In practice, the "account_inactive" error code is the one that is most likely to be
;; received. This would happen if access to the Slack workspace is manually revoked via the Slack UI.
#{"invalid_auth", "account_inactive", "token_revoked", "token_expired"}) |
Whether to send an email to all admins when an invalid or revoked token error is received in response to a Slack
API call. Should be set to false when checking if an unsaved token is valid. (Default: | (def ^:private ^:dynamic *send-token-error-emails?* true) |
(defn- handle-error [body]
(let [invalid-token? (slack-token-error-codes (:error body))
message (if invalid-token?
(trs "Invalid token")
(trs "Slack API error: {0}" (:error body)))
error (if invalid-token?
{:error-code (:error body)
:errors {:slack-token message}}
{:error-code (:error body)
:message message
:response body})]
(when (and invalid-token? *send-token-error-emails?*)
;; Check `slack-token-valid?` before sending emails to avoid sending repeat emails for the same invalid token.
;; We should send an email if `slack-token-valid?` is `true` or `nil` (i.e. a pre-existing bot integration is
;; being used)
(when (slack-token-valid?) (messages/send-slack-token-error-emails!))
(slack-token-valid?! false))
(when invalid-token?
(log/warn (u/pprint-to-str 'red (trs "🔒 Your Slack authorization token is invalid or has been revoked. Please update your integration in Admin Settings -> Slack."))))
(throw (ex-info message error)))) | |
(defn- handle-response [{:keys [status body]}]
(with-open [reader (io/reader body)]
(let [body (json/parse-stream reader true)]
(if (and (= 200 status) (:ok body))
body
(handle-error body))))) | |
(defn- do-slack-request [request-fn endpoint request]
(let [token (or (get-in request [:query-params :token])
(get-in request [:form-params :token])
(unobfuscated-slack-app-token)
(slack-token))]
(when token
(let [url (str "https://slack.com/api/" (name endpoint))
_ (log/trace "Slack API request: %s %s" (pr-str url) (pr-str request))
request (m/deep-merge
{:headers {:authorization (str "Bearer\n" token)}
:as :stream
;; use a relatively long connection timeout (10 seconds) in cases where we're fetching big
;; amounts of data -- see #11735
:conn-timeout 10000
:socket-timeout 10000}
(m/dissoc-in request [:query-params :token]))]
(try
(handle-response (request-fn url request))
(catch Throwable e
(throw (ex-info (.getMessage e) (merge (ex-data e) {:url url}) e)))))))) | |
Make a GET request to the Slack API. | (defn- GET
[endpoint & {:as query-params}]
(do-slack-request http/get endpoint {:query-params query-params})) |
Make a POST request to the Slack API. | (defn- POST [endpoint body] (do-slack-request http/post endpoint body)) |
Get a cursor for the next page of results in a Slack API response, if one exists. | (defn- next-cursor [response] (not-empty (get-in response [:response_metadata :next_cursor]))) |
Absolute maximum number of results to fetch from Slack API list endpoints. To prevent unbounded pagination of results. Don't set this too low -- some orgs have many thousands of channels (see #12978) | (def ^:private max-list-results 10000) |
Make a GET request to a Slack API list | (defn- paged-list-request
[endpoint response->data params]
;; use default limit (page size) of 1000 instead of 100 so we don't end up making a hundred API requests for orgs
;; with a huge number of channels or users.
(let [default-params {:limit 1000}
response (m/mapply GET endpoint (merge default-params params))
data (response->data response)]
(when (seq response)
(take
max-list-results
(concat
data
(when-let [next-cursor (next-cursor response)]
(lazy-seq
(paged-list-request endpoint response->data (assoc params :cursor next-cursor))))))))) |
Transformation from slack's api representation of a channel to our own. | (defn channel-transform
[channel]
{:display-name (str \# (:name channel))
:name (:name channel)
:id (:id channel)
:type "channel"}) |
Calls Slack API | (defn conversations-list
[& {:as query-parameters}]
(let [params (merge {:exclude_archived true, :types "public_channel"} query-parameters)]
(paged-list-request "conversations.list"
;; response -> channel names
#(->> % :channels (map channel-transform))
params))) |
Returns a Boolean indicating whether a channel with a given name exists in the cache. | (defn channel-exists?
[channel-name]
(boolean
(let [channel-names (into #{} (comp (map (juxt :name :id))
cat)
(:channels (slack-cached-channels-and-usernames)))]
(and channel-name (contains? channel-names channel-name))))) |
Check whether a Slack token is valid by checking if the | (mu/defn valid-token?
[token :- ms/NonBlankString]
(try
(binding [*send-token-error-emails?* false]
(boolean (take 1 (:channels (GET "conversations.list" :limit 1, :token token)))))
(catch Throwable e
(if (slack-token-error-codes (:error-code (ex-data e)))
false
(throw e))))) |
Tranformation from slack api user to our own internal representation. | (defn user-transform
[member]
{:display-name (str \@ (:name member))
:type "user"
:name (:name member)
:id (:id member)}) |
Calls Slack API | (defn users-list
[& {:as query-parameters}]
(->> (paged-list-request "users.list"
;; response -> user names
#(->> % :members (map user-transform))
query-parameters)
;; remove deleted users and bots. At the time of this writing there's no way to do this in the Slack API
;; itself so we need to do it after the fact.
(remove :deleted)
(remove :is_bot))) |
(defonce ^:private refresh-lock (Object.)) | |
(defn- needs-refresh? [] (u.date/older-than? (slack-channels-and-usernames-last-updated) (t/minutes 10))) | |
Clear the Slack channels cache, and reset its last-updated timestamp to its default value (the Unix epoch). | (defn clear-channel-cache!
[]
(slack-channels-and-usernames-last-updated! zoned-time-epoch)
(slack-cached-channels-and-usernames! {:channels []})) |
Refreshes users and conversations in slack-cache. finds both in parallel, sets [[slack-cached-channels-and-usernames]], and resets the [[slack-channels-and-usernames-last-updated]] time. | (defn refresh-channels-and-usernames!
[]
(when (slack-configured?)
(log/info "Refreshing slack channels and usernames.")
(let [users (future (vec (users-list)))
conversations (future (vec (conversations-list)))]
(slack-cached-channels-and-usernames! {:channels (concat @conversations @users)})
(slack-channels-and-usernames-last-updated! (t/zoned-date-time))))) |
Refreshes users and conversations in slack-cache on a per-instance lock. | (defn refresh-channels-and-usernames-when-needed!
[]
(when (needs-refresh?)
(locking refresh-lock
(when (needs-refresh?)
(refresh-channels-and-usernames!))))) |
Looks in [[slack-cached-channels-and-usernames]] to check whether a channel exists with the expected name from the [[slack-files-channel]] setting with an # prefix. If it does, returns the channel details as a map. If it doesn't, throws an error that advices an admin to create it. | (defn files-channel
[]
(let [channel-name (slack-files-channel)]
(if (channel-exists? channel-name)
channel-name
(let [message (str (tru "Slack channel named `{0}` is missing!" channel-name)
" "
(tru "Please create or unarchive the channel in order to complete the Slack integration.")
" "
(tru "The channel is used for storing images that are included in dashboard subscriptions."))]
(log/error (u/format-color 'red message))
(throw (ex-info message {:status-code 400})))))) |
(def ^:private NonEmptyByteArray [:and (ms/InstanceOfClass (Class/forName "[B")) [:fn not-empty]]) | |
Given a channel ID, calls Slack API | (mu/defn join-channel!
[channel-id :- ms/NonBlankString]
(POST "conversations.join" {:form-params {:channel channel-id}})) |
Slack requires the slack app to be in the channel that we post all of our attachments to. Slack changed (around June 2022 #23229) the "conversations.join" api to require the internal slack id rather than the common name. This makes a lot of sense to ensure we continue to operate despite channel renames. Attempt to look up the channel-id in the list of channels to obtain the internal id. Fallback to using the current channel-id. | (defn- maybe-lookup-id
[channel-id cached-channels]
(let [name->id (into {} (comp (filter (comp #{"channel"} :type))
(map (juxt :name :id)))
(:channels cached-channels))
channel-id' (get name->id channel-id channel-id)]
channel-id')) |
Calls Slack API | (mu/defn upload-file!
[file :- NonEmptyByteArray
filename :- ms/NonBlankString
channel-id :- ms/NonBlankString]
{:pre [(slack-configured?)]}
(let [request {:multipart [{:name "file", :content file}
{:name "filename", :content filename}
{:name "channels", :content channel-id}]}
response (try
(POST "files.upload" request)
(catch Throwable e
;; If file upload fails with a "not_in_channel" error, we join the channel and try again.
;; This is expected to happen the first time a Slack subscription is sent.
(if (= "not_in_channel" (:error-code (ex-data e)))
(do (-> channel-id
(maybe-lookup-id (slack-cached-channels-and-usernames))
join-channel!)
(POST "files.upload" request))
(throw e))))]
(u/prog1 (get-in response [:file :url_private])
(log/debug (trs "Uploaded image") <>)))) |
Calls Slack API | (mu/defn post-chat-message!
[channel-id :- ms/NonBlankString
text-or-nil :- [:maybe :string]
& [attachments]]
;; TODO: it would be nice to have an emoji or icon image to use here
(POST "chat.postMessage"
{:form-params
{:channel channel-id
:username "MetaBot"
:icon_url "http://static.metabase.com/metabot_slack_avatar_whitebg.png"
:text text-or-nil
:attachments (when (seq attachments)
(json/generate-string attachments))}})) |
(ns metabase.lib.aggregation (:refer-clojure :exclude [count distinct max min var]) (:require [medley.core :as m] [metabase.lib.common :as lib.common] [metabase.lib.dispatch :as lib.dispatch] [metabase.lib.equality :as lib.equality] [metabase.lib.hierarchy :as lib.hierarchy] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.options :as lib.options] [metabase.lib.ref :as lib.ref] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.aggregation :as lib.schema.aggregation] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.lib.temporal-bucket :as lib.temporal-bucket] [metabase.lib.types.isa :as lib.types.isa] [metabase.lib.util :as lib.util] [metabase.shared.util.i18n :as i18n] [metabase.util :as u] [metabase.util.malli :as mu])) | |
(mu/defn column-metadata->aggregation-ref :- :mbql.clause/aggregation
"Given `:metadata/column` column metadata for an aggregation, construct an `:aggregation` reference."
[metadata :- lib.metadata/ColumnMetadata]
(let [options {:lib/uuid (str (random-uuid))
:effective-type ((some-fn :effective-type :base-type) metadata)
:lib/source-name (:name metadata)}
ag-uuid (:lib/source-uuid metadata)]
(assert ag-uuid "Metadata for an aggregation reference should include :lib/source-uuid")
[:aggregation options ag-uuid])) | |
(mu/defn resolve-aggregation :- ::lib.schema.aggregation/aggregation
"Resolve an aggregation with a specific `ag-uuid`."
[query :- ::lib.schema/query
stage-number :- :int
ag-uuid :- :string]
(let [{aggregations :aggregation} (lib.util/query-stage query stage-number)
found (m/find-first (comp #{ag-uuid} :lib/uuid second) aggregations)]
(when-not found
(throw (ex-info (i18n/tru "No aggregation with uuid {0}" ag-uuid)
{:uuid ag-uuid
:query query
:stage-number stage-number})))
found)) | |
(defmethod lib.metadata.calculation/describe-top-level-key-method :aggregation
[query stage-number _k]
(when-let [aggregations (not-empty (:aggregation (lib.util/query-stage query stage-number)))]
(lib.util/join-strings-with-conjunction
(i18n/tru "and")
(for [aggregation aggregations]
(lib.metadata.calculation/display-name query stage-number aggregation :long))))) | |
(defmethod lib.metadata.calculation/metadata-method :aggregation
[query stage-number [_ag {:keys [base-type effective-type], :as _opts} index, :as _aggregation-ref]]
(let [aggregation (resolve-aggregation query stage-number index)]
(merge
(lib.metadata.calculation/metadata query stage-number aggregation)
{:lib/source :source/aggregations
:lib/source-uuid (:lib/uuid (second aggregation))}
(when base-type
{:base-type base-type})
(when effective-type
{:effective-type effective-type})))) | |
TODO -- merge this stuff into | |
(defmethod lib.metadata.calculation/display-name-method :aggregation [query stage-number [_tag _opts index] style] (lib.metadata.calculation/display-name query stage-number (resolve-aggregation query stage-number index) style)) | |
(lib.hierarchy/derive ::count-aggregation ::aggregation) | |
count and cumulative count can both be used either with no args (count of rows) or with one arg (count of X, which
I think means count where X is not NULL or something like that. Basically | (doseq [tag [:count
:cum-count]]
(lib.hierarchy/derive tag ::count-aggregation)) |
(defmethod lib.metadata.calculation/display-name-method ::count-aggregation
[query stage-number [tag _opts x] style]
;; x is optional.
(if x
(let [x-display-name (lib.metadata.calculation/display-name query stage-number x style)]
(case tag
:count (i18n/tru "Count of {0}" x-display-name)
:cum-count (i18n/tru "Cumulative count of {0}" x-display-name)))
(case tag
:count (i18n/tru "Count")
:cum-count (i18n/tru "Cumulative count")))) | |
(defmethod lib.metadata.calculation/column-name-method ::count-aggregation
[_query _stage-number [tag :as _clause]]
(case tag
:count "count"
:cum-count "cum_count")) | |
(defmethod lib.metadata.calculation/metadata-method ::count-aggregation
[query stage-number clause]
(assoc ((get-method lib.metadata.calculation/metadata-method ::aggregation) query stage-number clause)
:semantic-type :type/Quantity)) | |
(defmethod lib.metadata.calculation/display-name-method :case [_query _stage-number _case _style] (i18n/tru "Case")) | |
(defmethod lib.metadata.calculation/column-name-method :case [_query _stage-number _case] "case") | |
TODO - Should | |
(lib.hierarchy/derive ::unary-aggregation ::aggregation) | |
(doseq [tag [:avg
:cum-sum
:distinct
:max
:median
:min
:stddev
:sum
:var]]
(lib.hierarchy/derive tag ::unary-aggregation)) | |
(defmethod lib.metadata.calculation/column-name-method ::unary-aggregation
[_query _stage-number [tag _opts _arg]]
(case tag
:avg "avg"
:cum-sum "sum"
:distinct "count"
:max "max"
:median "median"
:min "min"
:stddev "stddev"
:sum "sum"
:var "var")) | |
(defmethod lib.metadata.calculation/display-name-method ::unary-aggregation
[query stage-number [tag _opts arg] style]
(let [arg (lib.metadata.calculation/display-name query stage-number arg style)]
(case tag
:avg (i18n/tru "Average of {0}" arg)
:cum-sum (i18n/tru "Cumulative sum of {0}" arg)
:distinct (i18n/tru "Distinct values of {0}" arg)
:max (i18n/tru "Max of {0}" arg)
:median (i18n/tru "Median of {0}" arg)
:min (i18n/tru "Min of {0}" arg)
:stddev (i18n/tru "Standard deviation of {0}" arg)
:sum (i18n/tru "Sum of {0}" arg)
:var (i18n/tru "Variance of {0}" arg)))) | |
(defmethod lib.metadata.calculation/display-name-method :percentile
[query stage-number [_percentile _opts x p] style]
(i18n/tru "{0}th percentile of {1}" p (lib.metadata.calculation/display-name query stage-number x style))) | |
(defmethod lib.metadata.calculation/column-name-method :percentile [_query _stage-number _clause] "percentile") | |
(lib.hierarchy/derive :percentile ::aggregation) | |
we don't currently have sophisticated logic for generating nice display names for filter clauses. TODO : wait a minute, we do have that stuff now! | |
(defmethod lib.metadata.calculation/display-name-method :sum-where
[query stage-number [_sum-where _opts x _pred] style]
(i18n/tru "Sum of {0} matching condition" (lib.metadata.calculation/display-name query stage-number x style))) | |
(defmethod lib.metadata.calculation/column-name-method :sum-where [query stage-number [_sum-where _opts x _pred]] (str "sum_where_" (lib.metadata.calculation/column-name query stage-number x))) | |
(lib.hierarchy/derive :sum-where ::aggregation) | |
(defmethod lib.metadata.calculation/display-name-method :share [_query _stage-number _share _style] (i18n/tru "Share of rows matching condition")) | |
(defmethod lib.metadata.calculation/column-name-method :share [_query _stage-number _share] "share") | |
(lib.hierarchy/derive :share ::aggregation) | |
(defmethod lib.metadata.calculation/display-name-method :count-where [_query _stage-number _count-where _style] (i18n/tru "Count of rows matching condition")) | |
(defmethod lib.metadata.calculation/column-name-method :count-where [_query _stage-number _count-where] "count-where") | |
(lib.hierarchy/derive :count-where ::aggregation) | |
(defmethod lib.metadata.calculation/metadata-method ::aggregation
[query stage-number [_tag _opts first-arg :as clause]]
(merge
;; flow the `:options` from the field we're aggregating. This is important, for some reason.
;; See [[metabase.query-processor-test.aggregation-test/field-settings-for-aggregate-fields-test]]
(when first-arg
(select-keys (lib.metadata.calculation/metadata query stage-number first-arg) [:settings]))
((get-method lib.metadata.calculation/metadata-method :default) query stage-number clause))) | |
(lib.common/defop count [] [x]) (lib.common/defop cum-count [] [x]) (lib.common/defop count-where [x y]) (lib.common/defop avg [x]) (lib.common/defop distinct [x]) (lib.common/defop max [x]) (lib.common/defop median [x]) (lib.common/defop min [x]) (lib.common/defop percentile [x y]) (lib.common/defop share [x]) (lib.common/defop stddev [x]) (lib.common/defop sum [x]) (lib.common/defop cum-sum [x]) (lib.common/defop sum-where [x y]) (lib.common/defop var [x]) | |
(defmethod lib.ref/ref-method :aggregation [aggregation-clause] aggregation-clause) | |
Schema for something you can pass to [[aggregate]] to add to a query as an aggregation. | (def ^:private Aggregable [:or ::lib.schema.aggregation/aggregation ::lib.schema.common/external-op lib.metadata/MetricMetadata]) |
(mu/defn aggregate :- ::lib.schema/query
"Adds an aggregation to query."
([query aggregable]
(aggregate query -1 aggregable))
([query :- ::lib.schema/query
stage-number :- :int
aggregable :- Aggregable]
;; if this is a Metric metadata, convert it to `:metric` MBQL clause before adding.
(if (= (lib.dispatch/dispatch-value aggregable) :metadata/metric)
(recur query stage-number (lib.ref/ref aggregable))
(lib.util/add-summary-clause query stage-number :aggregation aggregable)))) | |
(mu/defn aggregations :- [:maybe [:sequential ::lib.schema.aggregation/aggregation]]
"Get the aggregations in a given stage of a query."
([query]
(aggregations query -1))
([query :- ::lib.schema/query
stage-number :- :int]
(not-empty (:aggregation (lib.util/query-stage query stage-number))))) | |
(mu/defn aggregations-metadata :- [:maybe [:sequential lib.metadata/ColumnMetadata]]
"Get metadata about the aggregations in a given stage of a query."
([query]
(aggregations-metadata query -1))
([query :- ::lib.schema/query
stage-number :- :int]
(some->> (not-empty (:aggregation (lib.util/query-stage query stage-number)))
(into [] (map (fn [aggregation]
(let [metadata (lib.metadata.calculation/metadata query stage-number aggregation)]
(-> metadata
(u/assoc-default :effective-type (or (:base-type metadata) :type/*))
(assoc :lib/source :source/aggregations
:lib/source-uuid (:lib/uuid (second aggregation))))))))))) | |
(def ^:private OperatorWithColumns
[:merge
::lib.schema.aggregation/operator
[:map
[:columns {:optional true} [:sequential lib.metadata/ColumnMetadata]]]]) | |
(defmethod lib.metadata.calculation/display-name-method :operator/aggregation
[_query _stage-number {:keys [display-info]} _display-name-style]
(:display-name (display-info))) | |
(defmethod lib.metadata.calculation/display-info-method :operator/aggregation
[_query _stage-number {:keys [display-info requires-column? selected?] short-name :short}]
(cond-> (assoc (display-info)
:short-name (u/qualified-name short-name)
:requires-column requires-column?)
(some? selected?) (assoc :selected selected?))) | |
(mu/defn aggregation-operator-columns :- [:maybe [:sequential lib.metadata/ColumnMetadata]] "Returns the columns for which `aggregation-operator` is applicable." [aggregation-operator :- OperatorWithColumns] (:columns aggregation-operator)) | |
(mu/defn available-aggregation-operators :- [:maybe [:sequential OperatorWithColumns]]
"Returns the available aggegation operators for the stage with `stage-number` of `query`.
If `stage-number` is omitted, uses the last stage."
([query]
(available-aggregation-operators query -1))
([query :- ::lib.schema/query
stage-number :- :int]
(let [db-features (or (:features (lib.metadata/database query)) #{})
stage (lib.util/query-stage query stage-number)
columns (lib.metadata.calculation/visible-columns query stage-number stage)
with-columns (fn [{:keys [requires-column? supported-field] :as operator}]
(cond
(not requires-column?)
operator
(= supported-field :any)
(assoc operator :columns columns)
:else
(when-let [cols (->> columns
(filterv #(lib.types.isa/field-type? supported-field %))
not-empty)]
(assoc operator :columns cols))))]
(not-empty
(into []
(comp (filter (fn [op]
(let [feature (:driver-feature op)]
(or (nil? feature) (db-features feature)))))
(keep with-columns)
(map #(assoc % :lib/type :operator/aggregation)))
lib.schema.aggregation/aggregation-operators))))) | |
(mu/defn aggregation-clause :- ::lib.schema.aggregation/aggregation
"Returns a standalone aggregation clause for an `aggregation-operator` and
a `column`.
For aggregations requiring an argument `column` is mandatory, otherwise
it is optional."
([aggregation-operator :- ::lib.schema.aggregation/operator]
(if-not (:requires-column? aggregation-operator)
(lib.options/ensure-uuid [(:short aggregation-operator) {}])
(throw (ex-info (lib.util/format "aggregation operator %s requires an argument"
(:short aggregation-operator))
{:aggregation-operator aggregation-operator}))))
([aggregation-operator :- ::lib.schema.aggregation/operator
column]
(lib.options/ensure-uuid [(:short aggregation-operator) {} (lib.common/->op-arg column)]))) | |
(def ^:private SelectedOperatorWithColumns
[:merge
::lib.schema.aggregation/operator
[:map
[:columns {:optional true} [:sequential lib.metadata/ColumnMetadata]]
[:selected? {:optional true} :boolean]]]) | |
(mu/defn selected-aggregation-operators :- [:maybe [:sequential SelectedOperatorWithColumns]]
"Mark the operator and the column (if any) in `agg-operators` selected by `agg-clause`."
[agg-operators :- [:maybe [:sequential OperatorWithColumns]]
agg-clause]
(when (seq agg-operators)
(let [[op _ agg-col] agg-clause
agg-temporal-unit (-> agg-col lib.options/options :temporal-unit)]
(mapv (fn [agg-op]
(cond-> agg-op
(= (:short agg-op) op)
(-> (assoc :selected? true)
(m/update-existing
:columns
(fn [cols]
(if (lib.util/ref-clause? agg-col)
(let [cols (lib.equality/mark-selected-columns
cols
[(lib.options/update-options agg-col dissoc :temporal-unit)])]
(mapv (fn [c]
(cond-> c
(some? agg-temporal-unit)
(lib.temporal-bucket/with-temporal-bucket agg-temporal-unit)))
cols))
cols))))))
agg-operators)))) | |
(mu/defn aggregation-ref :- :mbql.clause/aggregation
"Find the aggregation at `ag-index` and create an `:aggregation` ref for it. Intended for use
when creating queries using threading macros e.g.
(-> (lib/query ...)
(lib/aggregate (lib/avg ...))
(as-> <> (lib/order-by <> (lib/aggregation-ref <> 0))))"
([query ag-index]
(aggregation-ref query -1 ag-index))
([query :- ::lib.schema/query
stage-number :- :int
ag-index :- ::lib.schema.common/int-greater-than-or-equal-to-zero]
(if-let [[_ {ag-uuid :lib/uuid}] (get (:aggregation (lib.util/query-stage query stage-number)) ag-index)]
(lib.options/ensure-uuid [:aggregation {} ag-uuid])
(throw (ex-info (str "Undefined aggregation " ag-index)
{:aggregation-index ag-index
:query query
:stage-number stage-number}))))) | |
(mu/defn aggregation-at-index :- [:maybe ::lib.schema.aggregation/aggregation]
"Get the aggregation at `index` in a stage of the query if it exists, otherwise `nil`. This is mostly for working
with legacy references like
[:aggregation 0]"
[query :- ::lib.schema/query
stage-number :- :int
index :- ::lib.schema.common/int-greater-than-or-equal-to-zero]
(let [ags (aggregations query stage-number)]
(when (> (clojure.core/count ags) index)
(nth ags index)))) | |
(mu/defn aggregation-column :- [:maybe ::lib.schema.metadata/column]
"Returns the column consumed by this aggregation, eg. the column being summed.
Returns nil for aggregations like `[:count]` that don't specify a column."
[query :- ::lib.schema/query
stage-number :- :int
[_operator _opts column-ref :as _aggregation] :- ::lib.schema.aggregation/aggregation]
(when column-ref
(->> (lib.util/query-stage query stage-number)
(lib.metadata.calculation/visible-columns query stage-number)
(lib.equality/find-matching-column column-ref)))) | |
(ns metabase.lib.binning (:require [metabase.lib.binning.util :as lib.binning.util] [metabase.lib.dispatch :as lib.dispatch] [metabase.lib.hierarchy :as lib.hierarchy] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.binning :as lib.schema.binning] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.shared.formatting.numbers :as fmt.num] [metabase.shared.util.i18n :as i18n] [metabase.util.malli :as mu])) | |
Implementation for [[with-binning]]. Implement this to tell [[with-binning]] how to add binning to a particular MBQL clause. | (defmulti with-binning-method
{:arglists '([x binning])}
(fn [x _binning]
(lib.dispatch/dispatch-value x)) :hierarchy lib.hierarchy/hierarchy) |
Add binning to an MBQL clause or something that can be converted to an MBQL clause.
Eg. for a Field or Field metadata or (with-binning some-field (bin-by :num-bins 4)) => [:field {:binning {:strategy :num-bins :num-bins 4}} 1] Pass | (mu/defn with-binning
{:style/indent [:form]}
[x binning :- [:maybe [:or ::lib.schema.binning/binning ::lib.schema.binning/binning-option]]]
(with-binning-method x (if (contains? binning :mbql)
(:mbql binning)
binning))) |
Implementation of [[binning]]. Return the current binning options associated with | (defmulti binning-method
{:arglists '([x])}
lib.dispatch/dispatch-value
:hierarchy lib.hierarchy/hierarchy) |
(defmethod binning-method :default [_x] nil) | |
(mu/defn binning :- [:maybe ::lib.schema.binning/binning] "Get the current binning options associated with `x`, if any." [x] (binning-method x)) | |
Implementation for [[available-binning-strategies]]. Return a set of binning strategies from
| (defmulti available-binning-strategies-method
{:arglists '([query stage-number x])}
(fn [_query _stage-number x]
(lib.dispatch/dispatch-value x))
:hierarchy lib.hierarchy/hierarchy) |
(defmethod available-binning-strategies-method :default [_query _stage-number _x] nil) | |
(mu/defn available-binning-strategies :- [:sequential [:ref ::lib.schema.binning/binning-option]]
"Get a set of available binning strategies for `x`. Returns nil if none are available."
([query x]
(available-binning-strategies query -1 x))
([query :- ::lib.schema/query
stage-number :- :int
x]
(available-binning-strategies-method query stage-number x))) | |
(mu/defn default-auto-bin :- ::lib.schema.binning/binning-option
"Returns the basic auto-binning strategy.
Public because it's used directly by some drill-thrus."
[]
{:lib/type :option/binning
:display-name (i18n/tru "Auto bin")
:default true
:mbql {:strategy :default}}) | |
(defn- with-binning-option-type [m] (assoc m :lib/type :option/binning)) | |
(mu/defn numeric-binning-strategies :- [:sequential ::lib.schema.binning/binning-option]
"List of binning options for numeric fields. These split the data evenly into a fixed number of bins."
[]
(mapv with-binning-option-type
[(default-auto-bin)
{:display-name (i18n/tru "10 bins") :mbql {:strategy :num-bins :num-bins 10}}
{:display-name (i18n/tru "50 bins") :mbql {:strategy :num-bins :num-bins 50}}
{:display-name (i18n/tru "100 bins") :mbql {:strategy :num-bins :num-bins 100}}])) | |
(mu/defn coordinate-binning-strategies :- [:sequential ::lib.schema.binning/binning-option]
"List of binning options for coordinate fields (ie. latitude and longitude). These split the data into as many
ranges as necessary, with each range being a certain number of degrees wide."
[]
(mapv with-binning-option-type
[(default-auto-bin)
{:display-name (i18n/tru "Bin every 0.1 degrees") :mbql {:strategy :bin-width :bin-width 0.1}}
{:display-name (i18n/tru "Bin every 1 degree") :mbql {:strategy :bin-width :bin-width 1.0}}
{:display-name (i18n/tru "Bin every 10 degrees") :mbql {:strategy :bin-width :bin-width 10.0}}
{:display-name (i18n/tru "Bin every 20 degrees") :mbql {:strategy :bin-width :bin-width 20.0}}])) | |
(mu/defn binning-display-name :- ::lib.schema.common/non-blank-string
"This is implemented outside of [[lib.metadata.calculation/display-name]] because it needs access to the field type.
It's called directly by `:field` or `:metadata/column`'s [[lib.metadata.calculation/display-name]]."
[{:keys [bin-width num-bins strategy] :as binning-options} :- ::lib.schema.binning/binning
column-metadata :- ::lib.schema.metadata/column]
(when binning-options
(case strategy
:num-bins (i18n/trun "{0} bin" "{0} bins" num-bins)
:bin-width (str (fmt.num/format-number bin-width {})
(when (isa? (:semantic-type column-metadata) :type/Coordinate)
"°"))
:default (i18n/tru "Auto binned")))) | |
(defmethod lib.metadata.calculation/display-info-method :option/binning [_query _stage-number binning-option] (select-keys binning-option [:display-name :default :selected])) | |
(defmethod lib.metadata.calculation/display-info-method ::binning
[query stage-number binning-value]
(let [field-metadata ((:metadata-fn binning-value) query stage-number)]
(merge {:display-name (binning-display-name binning-value field-metadata)}
(when (= :default (:strategy binning-value))
{:default true})))) | |
(mu/defn strategy= :- boolean?
"Given a binning option (as returned by [[available-binning-strategies]]) and the binning value (possibly nil) from
a column, check if they match."
[binning-option :- ::lib.schema.binning/binning-option
column-binning :- [:maybe ::lib.schema.binning/binning]]
(= (:mbql binning-option)
(select-keys column-binning [:strategy :num-bins :bin-width]))) | |
(mu/defn resolve-bin-width :- [:maybe [:map
[:bin-width ::lib.schema.binning/bin-width]
[:min-value number?]
[:max-value number?]]]
"If a `column` is binned, resolve the actual bin width that will be used when a query is processed as well as min
and max values."
[metadata-providerable :- ::lib.schema.metadata/metadata-providerable
column-metadata :- ::lib.schema.metadata/column
value :- number?]
(when-let [binning-options (binning column-metadata)]
(case (:strategy binning-options)
:num-bins
(when-let [{min-value :min, max-value :max, :as _number-fingerprint} (get-in column-metadata [:fingerprint :type :type/Number])]
(let [{:keys [num-bins]} binning-options
bin-width (lib.binning.util/nicer-bin-width min-value max-value num-bins)]
{:bin-width bin-width
:min-value value
:max-value (+ value bin-width)}))
:bin-width
(let [{:keys [bin-width]} binning-options]
(assert (number? bin-width))
{:bin-width bin-width
:min-value value
:max-value (+ value bin-width)})
:default
(when-let [{min-value :min, max-value :max, :as _number-fingerprint} (get-in column-metadata [:fingerprint :type :type/Number])]
(when-let [[_strategy {:keys [bin-width]}] (lib.binning.util/resolve-options metadata-providerable
:default
nil
column-metadata
min-value
max-value)]
{:bin-width bin-width
:min-value value
:max-value (+ value bin-width)}))))) | |
(ns metabase.lib.binning.util (:require [clojure.math :as math] [metabase.lib.metadata :as lib.metadata] [metabase.lib.schema.binning :as lib.schema.binning] [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.lib.types.isa :as lib.types.isa] [metabase.util :as u] [metabase.util.malli :as mu])) | |
(mu/defn ^:private calculate-bin-width :- ::lib.schema.binning/bin-width
"Calculate bin width required to cover interval [`min-value`, `max-value`] with `num-bins`."
[min-value :- number?
max-value :- number?
num-bins :- ::lib.schema.binning/num-bins]
(u/round-to-decimals 5 (/ (- max-value min-value)
num-bins))) | |
(mu/defn ^:private calculate-num-bins :- ::lib.schema.binning/num-bins
"Calculate number of bins of width `bin-width` required to cover interval [`min-value`, `max-value`]."
[min-value :- number?
max-value :- number?
bin-width :- ::lib.schema.binning/bin-width]
(max (long (math/ceil (/ (- max-value min-value)
bin-width)))
1)) | |
(def ^:private ResolvedStrategy
[:tuple
[:enum :bin-width :num-bins]
[:map
[:bin-width ::lib.schema.binning/bin-width]
[:num-bins ::lib.schema.binning/num-bins]]]) | |
(mu/defn ^:private resolve-default-strategy :- ResolvedStrategy
"Determine the approprate strategy & options to use when `:default` strategy was specified."
[metadata-providerable :- ::lib.schema.metadata/metadata-providerable
column :- ::lib.schema.metadata/column
min-value :- number?
max-value :- number?]
(if (lib.types.isa/coordinate? column)
(let [bin-width (lib.metadata/setting metadata-providerable :breakout-bin-width)]
[:bin-width
{:bin-width bin-width
:num-bins (calculate-num-bins min-value max-value bin-width)}])
(let [num-bins (lib.metadata/setting metadata-providerable :breakout-bins-num)]
[:num-bins
{:num-bins num-bins
:bin-width (calculate-bin-width min-value max-value num-bins)}]))) | |
------------------------------------- Humanized binning with nicer-breakout -------------------------------------- | |
(defn- ceil-to [precision x] (* (math/ceil (/ x precision)) precision)) | |
(defn- floor-to [precision x] (* (math/floor (/ x precision)) precision)) | |
(def ^:private pleasing-numbers [1 1.25 2 2.5 3 5 7.5 10]) | |
(mu/defn nicer-bin-width :- ::lib.schema.binning/bin-width
"Calculate the bin width we should use for `:num-bins` binning based on `min-value` and `max-value`, taken from a
column's fingerprint... rather than simply doing
(/ (- max-value min-value) num-bins)
this function attempts to return a 'pleasing' bin width, e.g. 20 instead of 15.01."
[min-value :- number?
max-value :- number?
num-bins :- ::lib.schema.binning/num-bins]
(let [min-bin-width (calculate-bin-width min-value max-value num-bins)
scale (math/pow 10 (u/order-of-magnitude min-bin-width))]
(some (fn [pleasing-number]
(let [candidate-width (* pleasing-number scale)]
(when (>= candidate-width min-bin-width)
candidate-width)))
pleasing-numbers))) | |
(mu/defn ^:private nicer-bounds :- [:tuple number? number?] [min-value :- number? max-value :- number? bin-width :- ::lib.schema.binning/bin-width] [(floor-to bin-width min-value) (ceil-to bin-width max-value)]) | |
(def ^:private ^:const max-steps 10) | |
(defn- fixed-point
[f]
(fn [x]
(->> (iterate f x)
(partition 2 1)
(take max-steps)
(drop-while (partial apply not=))
ffirst))) | |
(mu/defn ^:private nicer-breakout* :- :map
"Humanize binning: extend interval to start and end on a \"nice\" number and, when number of bins is fixed, have a
\"nice\" step (bin width)."
[strategy :- ::lib.schema.binning/strategy
{:keys [min-value max-value bin-width num-bins]} :- [:map
[:min-value number?]
[:max-value number?]
[:bin-width {:optional true} ::lib.schema.binning/bin-width]
[:num-bins {:optional true} ::lib.schema.binning/num-bins]]]
(let [bin-width (if (= strategy :num-bins)
(nicer-bin-width min-value max-value num-bins)
bin-width)
[min-value max-value] (nicer-bounds min-value max-value bin-width)]
{:min-value min-value
:max-value max-value
:num-bins (if (= strategy :num-bins)
num-bins
(calculate-num-bins min-value max-value bin-width))
:bin-width bin-width})) | |
(mu/defn nicer-breakout :- [:maybe :map]
"Make the current breakout a little nicer? Not 100% sure exactly how this is used, refer
to [[metabase.query-processor.middleware.binning/update-binned-field]]."
[strategy :- ::lib.schema.binning/strategy
opts :- :map]
(let [f (partial nicer-breakout* strategy)]
((fixed-point f) opts))) | |
(mu/defn resolve-options :- ResolvedStrategy
"Given any binning `:strategy`, determine the `:bin-width` and `:num-bins` we should use based on the column's
fingerprint."
[metadata-providerable :- ::lib.schema.metadata/metadata-providerable
strategy :- ::lib.schema.binning/strategy
strategy-param :- [:maybe number?]
column :- ::lib.schema.metadata/column
min-value :- number?
max-value :- number?]
(case strategy
:num-bins
[:num-bins
{:num-bins strategy-param
:bin-width (calculate-bin-width min-value max-value strategy-param)}]
:bin-width
[:bin-width
{:bin-width strategy-param
:num-bins (calculate-num-bins min-value max-value strategy-param)}]
:default
(resolve-default-strategy metadata-providerable column min-value max-value))) | |
(ns metabase.lib.breakout (:require [clojure.string :as str] [metabase.lib.binning :as lib.binning] [metabase.lib.equality :as lib.equality] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.ref :as lib.ref] [metabase.lib.remove-replace :as lib.remove-replace] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.expression :as lib.schema.expression] [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.lib.schema.ref :as lib.schema.ref] [metabase.lib.temporal-bucket :as lib.temporal-bucket] [metabase.lib.util :as lib.util] [metabase.shared.util.i18n :as i18n] [metabase.util.malli :as mu])) | |
(defmethod lib.metadata.calculation/describe-top-level-key-method :breakout
[query stage-number _k]
(when-let [breakouts (not-empty (:breakout (lib.util/query-stage query stage-number)))]
(i18n/tru "Grouped by {0}"
(str/join (str \space (i18n/tru "and") \space)
(for [breakout breakouts]
(lib.metadata.calculation/display-name query stage-number breakout :long)))))) | |
(mu/defn breakout :- ::lib.schema/query
"Add a new breakout on an expression, presumably a Field reference."
([query expr]
(breakout query -1 expr))
([query :- ::lib.schema/query
stage-number :- :int
expr :- some?]
(let [expr (lib.ref/ref (if (fn? expr)
(expr query stage-number)
expr))]
(lib.util/add-summary-clause query stage-number :breakout expr)))) | |
(mu/defn breakouts :- [:maybe [:sequential ::lib.schema.expression/expression]]
"Return the current breakouts"
([query]
(breakouts query -1))
([query :- ::lib.schema/query
stage-number :- :int]
(not-empty (:breakout (lib.util/query-stage query stage-number))))) | |
(mu/defn breakouts-metadata :- [:maybe [:sequential ::lib.schema.metadata/column]]
"Get metadata about the breakouts in a given stage of a `query`."
([query]
(breakouts-metadata query -1))
([query :- ::lib.schema/query
stage-number :- :int]
(some->> (breakouts query stage-number)
(mapv (fn [field-ref]
(-> (lib.metadata.calculation/metadata query stage-number field-ref)
(assoc :lib/source :source/breakouts))))))) | |
(mu/defn breakoutable-columns :- [:sequential ::lib.schema.metadata/column]
"Get column metadata for all the columns that can be broken out by in
the stage number `stage-number` of the query `query`
If `stage-number` is omitted, the last stage is used.
The rules for determining which columns can be broken out by are as follows:
1. custom `:expressions` in this stage of the query
2. Fields 'exported' by the previous stage of the query, if there is one;
otherwise Fields from the current `:source-table`
3. Fields exported by explicit joins
4. Fields in Tables that are implicitly joinable."
([query :- ::lib.schema/query]
(breakoutable-columns query -1))
([query :- ::lib.schema/query
stage-number :- :int]
(let [cols (let [stage (lib.util/query-stage query stage-number)
options {:include-implicitly-joinable-for-source-card? false}]
(lib.metadata.calculation/visible-columns query stage-number stage options))]
(when (seq cols)
(let [matching (into {} (keep-indexed (fn [index a-breakout]
(when-let [col (lib.equality/find-matching-column
query stage-number a-breakout cols
{:generous? true})]
[col [index a-breakout]]))
(or (breakouts query stage-number) [])))]
(mapv #(let [[pos a-breakout] (matching %)
binning (lib.binning/binning a-breakout)
{:keys [unit]} (lib.temporal-bucket/temporal-bucket a-breakout)]
(cond-> %
binning (lib.binning/with-binning binning)
unit (lib.temporal-bucket/with-temporal-bucket unit)
pos (assoc :breakout-position pos)))
cols)))))) | |
(mu/defn existing-breakouts :- [:maybe [:sequential {:min 1} ::lib.schema.ref/ref]]
"Returns existing breakouts (as MBQL expressions) for `column` in a stage if there are any. Returns `nil` if there
are no existing breakouts."
([query stage-number column]
(existing-breakouts query stage-number column nil))
([query :- ::lib.schema/query
stage-number :- :int
column :- ::lib.schema.metadata/column
{:keys [same-temporal-bucket?], :as _options} :- [:maybe
[:map
[:same-temporal-bucket? {:optional true} [:maybe :boolean]]]]]
(not-empty
(into []
(filter (fn [a-breakout]
(and (lib.equality/find-matching-column query stage-number a-breakout [column] {:generous? true})
(if same-temporal-bucket?
(= (lib.temporal-bucket/temporal-bucket a-breakout)
(lib.temporal-bucket/temporal-bucket column))
true))))
(breakouts query stage-number))))) | |
Returns if | (defn breakout-column? [query stage-number column] (seq (existing-breakouts query stage-number column))) |
(mu/defn remove-existing-breakouts-for-column :- ::lib.schema/query
"Remove all existing breakouts against `column` if there are any in the stage in question. Disregards temporal
bucketing and binning."
([query column]
(remove-existing-breakouts-for-column query -1 column))
([query :- ::lib.schema/query
stage-number :- :int
column :- ::lib.schema.metadata/column]
(reduce
(fn [query a-breakout]
(lib.remove-replace/remove-clause query stage-number a-breakout))
query
(existing-breakouts query stage-number column)))) | |
(mu/defn breakout-column :- ::lib.schema.metadata/column
"Returns the input column used for this breakout."
[query :- ::lib.schema/query
stage-number :- :int
breakout-ref :- ::lib.schema.ref/ref]
(->> (lib.util/query-stage query stage-number)
(lib.metadata.calculation/visible-columns query stage-number)
(lib.equality/find-matching-column breakout-ref))) | |
(ns metabase.lib.cache) | |
(CLJS only; this is a pass-through in CLJ.) Attaches a JS property If there is not already a key | (defn side-channel-cache
[subkey x f]
(comment subkey) ; Avoids lint warning for half-unused `subkey`.
#?(:clj (f x)
:cljs (if (or (object? x) (map? x))
(do
(when-not (.-__mbcache ^js x)
(set! (.-__mbcache ^js x) (atom {})))
(if-let [cache (.-__mbcache ^js x)]
(if-let [cached (get @cache subkey)]
cached
;; Cache miss - generate the value and cache it.
(let [value (f x)]
(swap! cache assoc subkey value)
value))
(f x)))
(f x)))) |
(ns metabase.lib.card (:require [metabase.lib.convert :as lib.convert] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.query :as lib.query] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.id :as lib.schema.id] [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.lib.util :as lib.util] [metabase.shared.util.i18n :as i18n] [metabase.util :as u] [metabase.util.humanization :as u.humanization] [metabase.util.malli :as mu])) | |
(defmethod lib.metadata.calculation/display-name-method :metadata/card [_query _stage-number card-metadata _style] ((some-fn :display-name :name) card-metadata)) | |
(defmethod lib.metadata.calculation/metadata-method :metadata/card
[_query _stage-number {card-name :name, :keys [display-name], :as card-metadata}]
(cond-> card-metadata
(not display-name) (assoc :display-name (u.humanization/name->human-readable-name :simple card-name)))) | |
(defmethod lib.metadata.calculation/visible-columns-method :metadata/card
[query
stage-number
{:keys [fields result-metadata] :as card-metadata}
{:keys [include-implicitly-joinable? unique-name-fn] :as options}]
(concat
(lib.metadata.calculation/returned-columns query stage-number card-metadata options)
(when include-implicitly-joinable?
(lib.metadata.calculation/implicitly-joinable-columns
query stage-number (concat fields result-metadata) unique-name-fn)))) | |
(mu/defn fallback-display-name :- ::lib.schema.common/non-blank-string
"If for some reason the metadata is unavailable. This is better than returning nothing I guess."
[card-id :- ::lib.schema.id/card]
(i18n/tru "Question {0}" (pr-str card-id))) | |
(defmethod lib.metadata.calculation/describe-top-level-key-method :source-card
[query stage-number _k]
(let [{:keys [source-card]} (lib.util/query-stage query stage-number)]
(when source-card
(or (when-let [card-metadata (lib.metadata/card query source-card)]
(lib.metadata.calculation/display-name query stage-number card-metadata :long))
(fallback-display-name source-card))))) | |
(mu/defn ^:private infer-returned-columns :- [:maybe [:sequential ::lib.schema.metadata/column]]
[metadata-providerable :- lib.metadata/MetadataProviderable
card-query :- :map]
(when (some? card-query)
(lib.metadata.calculation/returned-columns (lib.query/query metadata-providerable (lib.convert/->pMBQL card-query))))) | |
(def ^:private Card
[:map
{:error/message "Card with :dataset-query"}
[:dataset-query :map]]) | |
Things are fundamentally broken because of #29763, and every time I try to fix this is ends up being a giant mess to untangle. The FE currently ignores results metadata for ad-hoc queries, and thus cannot match up 'correct' Field refs like 'Products__CATEGORY'... for the time being we'll have to force ID refs even when we should be using nominal refs so as to not completely destroy the FE. Once we port more stuff over maybe we can fix this. | (def ^:dynamic *force-broken-card-refs* true) |
(mu/defn ->card-metadata-column :- ::lib.schema.metadata/column
"Massage possibly-legacy Card results metadata into MLv2 ColumnMetadata."
([metadata-providerable col]
(->card-metadata-column metadata-providerable nil col))
([metadata-providerable :- lib.metadata/MetadataProviderable
card-or-id :- [:maybe [:or ::lib.schema.id/card ::lib.schema.metadata/card]]
col :- :map]
(let [col (-> col
(update-keys u/->kebab-case-en)
;; ignore `:field-ref`, it's very likely a legacy field ref, and it's probably wrong either way. We
;; can always calculate a new one.
(dissoc :field-ref))]
(cond-> (merge
{:base-type :type/*, :lib/type :metadata/column}
(when-let [field-id (:id col)]
(try
(lib.metadata/field metadata-providerable field-id)
(catch #?(:clj Throwable :cljs :default) _
nil)))
col
{:lib/type :metadata/column
:lib/source :source/card
:lib/source-column-alias ((some-fn :lib/source-column-alias :name) col)})
card-or-id
(assoc :lib/card-id (u/the-id card-or-id))
(and *force-broken-card-refs*
;; never force broken refs for datasets, because datasets can have give columns with completely
;; different names the Field ID of a different column, somehow. See #22715
(or
;; we can only do this check if `card-or-id` is passed in.
(not card-or-id)
(not (:dataset (lib.metadata/card metadata-providerable (u/the-id card-or-id))))))
(assoc ::force-broken-id-refs true)
;; If the incoming col doesn't have `:semantic-type :type/FK`, drop `:fk-target-field-id`.
;; This comes up with metadata on SQL cards, which might be linked to their original DB field but should not be
;; treated as FKs unless the metadata is configured accordingly.
(not= (:semantic-type col) :type/FK)
(assoc :fk-target-field-id nil))))) | |
(def ^:private CardColumnMetadata
[:merge
::lib.schema.metadata/column
[:map
[:lib/source [:= :source/card]]]]) | |
(def ^:private CardColumns
[:maybe [:sequential {:min 1} CardColumnMetadata]]) | |
(mu/defn ^:private card-metadata-columns :- CardColumns
[metadata-providerable :- lib.metadata/MetadataProviderable
card :- Card]
(when-let [result-metadata (or (:fields card)
(:result-metadata card)
(infer-returned-columns metadata-providerable (:dataset-query card)))]
;; Card `result-metadata` SHOULD be a sequence of column infos, but just to be safe handle a map that
;; contains` :columns` as well.
(when-let [cols (not-empty (cond
(map? result-metadata) (:columns result-metadata)
(sequential? result-metadata) result-metadata))]
(mapv (partial ->card-metadata-column metadata-providerable card)
cols)))) | |
(mu/defn saved-question-metadata :- CardColumns
"Metadata associated with a Saved Question with `card-id`."
[metadata-providerable :- lib.metadata/MetadataProviderable
card-id :- ::lib.schema.id/card]
;; it seems like in some cases (unit tests) the FE is renaming `:result-metadata` to `:fields`, not 100% sure why
;; but handle that case anyway. (#29739)
(when-let [card (lib.metadata/card metadata-providerable card-id)]
(card-metadata-columns metadata-providerable card))) | |
(defmethod lib.metadata.calculation/returned-columns-method :metadata/card
[query _stage-number card {:keys [unique-name-fn], :as _options}]
(mapv (fn [col]
(let [desired-alias ((some-fn :lib/desired-column-alias :lib/source-column-alias :name) col)]
(assoc col :lib/desired-column-alias (unique-name-fn desired-alias))))
(card-metadata-columns query card))) | |
(ns metabase.lib.column-group (:require [medley.core :as m] [metabase.lib.card :as lib.card] [metabase.lib.join :as lib.join] [metabase.lib.join.util :as lib.join.util] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.id :as lib.schema.id] [metabase.lib.util :as lib.util] [metabase.util.malli :as mu])) | |
(def ^:private GroupType [:enum ;; the `:group-type/main` group includes all the columns from the source Table/Card/previous stage as well as ones ;; added in this stage. :group-type/main ;; the other two group types are for various types of joins. :group-type/join.explicit :group-type/join.implicit]) | |
Schema for the metadata returned by [[group-columns]], and accepted by [[columns-group-columns]]. | (def ^:private ColumnGroup
[:and
[:map
[:lib/type [:= :metadata/column-group]]
[::group-type GroupType]
[::columns [:sequential lib.metadata/ColumnMetadata]]]
[:multi
{:dispatch ::group-type}
[:group-type/main
any?]
;; if we're in the process of BUILDING a join and using this in combination
;; with [[metabase.lib.join/join-condition-rhs-columns]], the alias won't be present yet, so group things by the
;; joinable -- either the Card we're joining, or the Table we're joining. See #32493
[:group-type/join.explicit
[:and
[:map
[:join-alias {:optional true} [:ref ::lib.schema.common/non-blank-string]]
[:table-id {:optional true} [:ref ::lib.schema.id/table]]
[:card-id {:optional true} [:ref ::lib.schema.id/card]]]
[:fn
{:error/message ":group-type/join.explicit should only have at most one of :join-alias, :table-id, or :card-id"}
(fn [m]
(>= (count (keys (select-keys m [:join-alias :table-id :card-id]))) 1))]]]
[:group-type/join.implicit
[:map
[:fk-field-id [:ref ::lib.schema.id/field]]]]]]) |
(defmethod lib.metadata.calculation/metadata-method :metadata/column-group [_query _stage-number column-group] column-group) | |
(defmulti ^:private display-info-for-group-method
{:arglists '([query stage-number column-group])}
(fn [_query _stage-number column-group]
(::group-type column-group))) | |
(defmethod display-info-for-group-method :group-type/main
[query stage-number _column-group]
(merge
(let [stage (lib.util/query-stage query stage-number)]
(or
(when-let [table (some->> (:source-table stage) (lib.metadata/table query))]
(lib.metadata.calculation/display-info query stage-number table))
(when-let [card (some->> (:source-card stage) (lib.metadata/card query))]
(lib.metadata.calculation/display-info query stage-number card))
;; for multi-stage queries return an empty string (#30108)
(when (next (:stages query))
{:display-name ""})
;; if this is a native query or something else that doesn't have a source Table or source Card then use the
;; stage display name.
{:display-name (lib.metadata.calculation/display-name query stage-number stage)}))
{:is-from-join false
:is-implicitly-joinable false})) | |
(defmethod display-info-for-group-method :group-type/join.explicit
[query stage-number {:keys [join-alias table-id card-id], :as _column-group}]
(merge
(or
(when join-alias
(when-let [join (lib.join/resolve-join query stage-number join-alias)]
(lib.metadata.calculation/display-info query stage-number join)))
(when table-id
(when-let [table (lib.metadata/table query table-id)]
(lib.metadata.calculation/display-info query stage-number table)))
(when card-id
(if-let [card (lib.metadata/card query card-id)]
(lib.metadata.calculation/display-info query stage-number card)
{:display-name (lib.card/fallback-display-name card-id)})))
{:is-from-join true
:is-implicitly-joinable false})) | |
(defmethod display-info-for-group-method :group-type/join.implicit
[query stage-number {:keys [fk-field-id], :as _column-group}]
(merge
(when-let [;; TODO: This is clumsy and expensive; there is likely a neater way to find the full FK column.
;; Note that using `lib.metadata/field` is out - we need to respect metadata overrides etc. in models, and
;; `lib.metadata/field` uses the field's original status.
fk-column (->> (lib.util/query-stage query stage-number)
(lib.metadata.calculation/visible-columns query stage-number)
(m/find-first #(and (= (:id %) fk-field-id)
(:fk-target-field-id %))))]
(let [fk-info (lib.metadata.calculation/display-info query stage-number fk-column)]
;; Implicitly joined column pickers don't use the target table's name, they use the FK field's name with
;; "ID" dropped instead.
;; This is very intentional: one table might have several FKs to one foreign table, each with different
;; meaning (eg. ORDERS.customer_id vs. ORDERS.supplier_id both linking to a PEOPLE table).
;; See #30109 for more details.
(update fk-info :display-name lib.util/strip-id)))
{:is-from-join false
:is-implicitly-joinable true})) | |
(defmethod lib.metadata.calculation/display-info-method :metadata/column-group [query stage-number column-group] (display-info-for-group-method query stage-number column-group)) | |
(defmulti ^:private column-group-info-method
{:arglists '([column-metadata])}
:lib/source) | |
(defmethod column-group-info-method :source/implicitly-joinable
[column-metadata]
{::group-type :group-type/join.implicit,
:fk-field-id (:fk-field-id column-metadata)
:fk-join-alias (:fk-join-alias column-metadata)}) | |
(defmethod column-group-info-method :source/joins
[{:keys [table-id], :lib/keys [card-id], :as column-metadata}]
(merge
{::group-type :group-type/join.explicit}
;; if we're in the process of BUILDING a join and using this in combination
;; with [[metabase.lib.join/join-condition-rhs-columns]], the alias won't be present yet, so group things by the
;; joinable -- either the Card we're joining, or the Table we're joining. Prefer `:lib/card-id` because when we
;; join a Card the Fields might have `:table-id` but we want the entire Card to appear as one group. See #32493
(or
(when-let [join-alias (lib.join.util/current-join-alias column-metadata)]
{:join-alias join-alias})
(when card-id
{:card-id card-id})
(when table-id
{:table-id table-id})))) | |
(defmethod column-group-info-method :default
[_column-metadata]
{::group-type :group-type/main}) | |
(mu/defn ^:private column-group-info :- [:map [::group-type GroupType]] "The value we should use to `group-by` inside [[group-columns]]." [column-metadata :- lib.metadata/ColumnMetadata] (column-group-info-method column-metadata)) | |
(mu/defn group-columns :- [:sequential ColumnGroup]
"Given a group of columns returned by a function like [[metabase.lib.order-by/orderable-columns]], group the columns
by Table or equivalent (e.g. Saved Question) so that they're in an appropriate shape for showing in the Query
Builder. e.g a sequence of columns like
[venues.id
venues.name
venues.category-id
;; implicitly joinable
categories.id
categories.name]
would get grouped into groups like
[{::columns [venues.id
venues.name
venues.category-id]}
{::columns [categories.id
categories.name]}]
Groups have the type `:metadata/column-group` and can be passed directly
to [[metabase.lib.metadata.calculation/display-info]]."
[column-metadatas :- [:sequential lib.metadata/ColumnMetadata]]
(mapv (fn [[group-info columns]]
(assoc group-info
:lib/type :metadata/column-group
::columns columns))
(group-by column-group-info column-metadatas))) | |
(mu/defn columns-group-columns :- [:sequential lib.metadata/ColumnMetadata] "Get the columns associated with a column group" [column-group :- ColumnGroup] (::columns column-group)) | |
(defmethod lib.metadata.calculation/display-name-method :metadata/column-group [query stage-number column-group _display-name-style] (:display-name (lib.metadata.calculation/display-info query stage-number column-group))) | |
Currently this is mostly a convenience namespace for REPL and test usage. We'll probably have a slightly different version of this for namespace for QB and QP usage in the future -- TBD. | (ns metabase.lib.core
(:refer-clojure :exclude [filter remove replace and or not = < <= > ->> >= not-empty case count distinct max min
+ - * / time abs concat replace ref var])
(:require
[metabase.lib.aggregation :as lib.aggregation]
[metabase.lib.binning :as lib.binning]
[metabase.lib.breakout :as lib.breakout]
[metabase.lib.card :as lib.card]
[metabase.lib.column-group :as lib.column-group]
[metabase.lib.common :as lib.common]
[metabase.lib.database :as lib.database]
[metabase.lib.drill-thru :as lib.drill-thru]
[metabase.lib.drill-thru.pivot :as lib.drill-thru.pivot]
[metabase.lib.equality :as lib.equality]
[metabase.lib.expression :as lib.expression]
[metabase.lib.fe-util :as lib.fe-util]
[metabase.lib.field :as lib.field]
[metabase.lib.filter :as lib.filter]
[metabase.lib.filter.update :as lib.filter.update]
[metabase.lib.join :as lib.join]
[metabase.lib.limit :as lib.limit]
[metabase.lib.metadata.calculation :as lib.metadata.calculation]
[metabase.lib.metadata.composed-provider :as lib.metadata.composed-provider]
[metabase.lib.metric :as lib.metric]
[metabase.lib.native :as lib.native]
[metabase.lib.normalize :as lib.normalize]
[metabase.lib.order-by :as lib.order-by]
[metabase.lib.query :as lib.query]
[metabase.lib.ref :as lib.ref]
[metabase.lib.remove-replace :as lib.remove-replace]
[metabase.lib.segment :as lib.segment]
[metabase.lib.stage :as lib.stage]
[metabase.lib.table :as lib.table]
[metabase.lib.temporal-bucket :as lib.temporal-bucket]
[metabase.shared.util.namespaces :as shared.ns])) |
(comment lib.aggregation/keep-me
lib.binning/keep-me
lib.breakout/keep-me
lib.card/keep-me
lib.column-group/keep-me
lib.common/keep-me
lib.database/keep-me
lib.drill-thru/keep-me
lib.drill-thru.pivot/keep-me
lib.equality/keep-me
lib.expression/keep-me
lib.field/keep-me
lib.filter/keep-me
lib.filter.update/keep-me
lib.join/keep-me
lib.limit/keep-me
lib.metadata.calculation/keep-me
lib.metadata.composed-provider/keep-me
lib.metric/keep-me
lib.native/keep-me
lib.normalize/keep-me
lib.order-by/keep-me
lib.query/keep-me
lib.ref/keep-me
lib.segment/keep-me
lib.stage/keep-me
lib.table/keep-me
lib.temporal-bucket/keep-me) | |
(shared.ns/import-fns [lib.aggregation aggregate aggregation-clause aggregation-column aggregation-ref aggregation-operator-columns aggregations aggregations-metadata available-aggregation-operators selected-aggregation-operators count avg count-where distinct max median min percentile share stddev sum sum-where var cum-count cum-sum] [lib.binning available-binning-strategies binning with-binning] [lib.breakout breakout breakout-column breakoutable-columns breakouts breakouts-metadata] [lib.column-group columns-group-columns group-columns] [lib.common external-op] [lib.database database-id] [lib.drill-thru available-drill-thrus drill-thru] [lib.drill-thru.pivot pivot-columns-for-type pivot-types] [lib.equality find-column-for-legacy-ref find-matching-column] [lib.expression expression expressions expressions-metadata expressionable-columns expression-ref with-expression-name + - * / case coalesce abs log exp sqrt ceil floor round power interval relative-datetime time absolute-datetime now convert-timezone get-week get-year get-month get-day get-hour get-minute get-second get-quarter datetime-add datetime-subtract concat substring replace regexextract length trim ltrim rtrim upper lower] [lib.fe-util expression-clause expression-parts filter-args-display-name] [lib.field add-field fieldable-columns fields find-visible-column-for-ref remove-field with-fields] [lib.filter filter filters filterable-columns filterable-column-operators filter-clause filter-operator find-filter-for-legacy-filter find-filterable-column-for-legacy-ref and or not = != < <= > >= between inside is-null not-null is-empty not-empty starts-with ends-with contains does-not-contain time-interval segment] [lib.filter.update update-lat-lon-filter update-numeric-filter update-temporal-filter] [lib.join available-join-strategies join join-clause join-condition-lhs-columns join-condition-operators join-condition-rhs-columns join-condition-update-temporal-bucketing join-conditions join-fields join-lhs-display-name join-strategy joinable-columns joins raw-join-strategy suggested-join-conditions with-join-alias with-join-fields with-join-strategy with-join-conditions] [lib.limit current-limit limit] [lib.metadata.calculation column-name describe-query describe-top-level-key display-name display-info metadata returned-columns suggested-name type-of visible-columns] [lib.metadata.composed-provider composed-metadata-provider] [lib.metric available-metrics] [lib.native native-query raw-native-query with-native-query template-tags engine with-template-tags required-native-extras native-extras with-native-extras with-different-database has-write-permission extract-template-tags] [lib.order-by change-direction order-by order-by-clause order-bys orderable-columns] [lib.normalize normalize] [lib.query can-run query stage-count with-different-table] [lib.ref ref] [lib.remove-replace remove-clause remove-join rename-join replace-clause replace-join] [lib.segment available-segments] [lib.stage append-stage drop-stage drop-stage-if-empty has-clauses?] [lib.temporal-bucket describe-temporal-unit describe-temporal-interval describe-relative-datetime available-temporal-buckets temporal-bucket with-temporal-bucket]) | |
(ns metabase.lib.database (:require [metabase.lib.metadata :as lib.metadata] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.id :as lib.schema.id] [metabase.lib.util :as lib.util] [metabase.mbql.schema :as mbql.s] [metabase.util.malli :as mu])) | |
(mu/defn database-id :- [:maybe ::lib.schema.id/database]
"Get the Database ID (`:database`) associated with a query. If the query is using
the [[mbql.s/saved-questions-virtual-database-id]] (used in some situations for queries with a `:source-card`)
{:database -1337}
we will attempt to resolve the correct Database ID by getting metadata for the source Card and returning its
`:database-id`; if this is not available for one reason or another this will return `nil`."
[query :- ::lib.schema/query]
(when-let [id (:database query)]
(if (not= id mbql.s/saved-questions-virtual-database-id)
id
(when-let [source-card-id (lib.util/source-card-id query)]
(when-let [card-metadata (lib.metadata/card query source-card-id)]
(:database-id card-metadata)))))) | |
(ns metabase.lib.dispatch (:require [metabase.util :as u])) | |
(defn- mbql-clause-type [x]
(when (and (vector? x)
(keyword? (first x)))
(first x))) | |
Dispatch value for a clause, map, or other object. Dispatch rules are as follows:
| (defn dispatch-value
[x]
;; TODO -- for Clj, we should probably handle Toucan instances as well, and dispatch off
;; of [[toucan2.core/model]]?
(or (mbql-clause-type x)
(when (map? x)
(:lib/type x))
(u/dispatch-type-keyword x))) |
(ns metabase.lib.drill-thru (:require [metabase.lib.drill-thru.automatic-insights :as lib.drill-thru.automatic-insights] [metabase.lib.drill-thru.column-filter :as lib.drill-thru.column-filter] [metabase.lib.drill-thru.common :as lib.drill-thru.common] [metabase.lib.drill-thru.distribution :as lib.drill-thru.distribution] [metabase.lib.drill-thru.fk-details :as lib.drill-thru.fk-details] [metabase.lib.drill-thru.fk-filter :as lib.drill-thru.fk-filter] [metabase.lib.drill-thru.object-details :as lib.drill-thru.object-details] [metabase.lib.drill-thru.pivot :as lib.drill-thru.pivot] [metabase.lib.drill-thru.pk :as lib.drill-thru.pk] [metabase.lib.drill-thru.quick-filter :as lib.drill-thru.quick-filter] [metabase.lib.drill-thru.sort :as lib.drill-thru.sort] [metabase.lib.drill-thru.summarize-column :as lib.drill-thru.summarize-column] [metabase.lib.drill-thru.summarize-column-by-time :as lib.drill-thru.summarize-column-by-time] [metabase.lib.drill-thru.underlying-records :as lib.drill-thru.underlying-records] [metabase.lib.drill-thru.zoom :as lib.drill-thru.zoom] [metabase.lib.drill-thru.zoom-in-bins :as lib.drill-thru.zoom-in-bins] [metabase.lib.drill-thru.zoom-in-geographic :as lib.drill-thru.zoom-in-geographic] [metabase.lib.drill-thru.zoom-in-timeseries :as lib.drill-thru.zoom-in-timeseries] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.drill-thru :as lib.schema.drill-thru] [metabase.util :as u] [metabase.util.log :as log] [metabase.util.malli :as mu])) | |
(comment lib.drill-thru.fk-details/keep-me lib.drill-thru.pk/keep-me lib.drill-thru.zoom/keep-me) | |
(defmethod lib.metadata.calculation/display-info-method ::drill-thru [query stage-number drill-thru] (lib.drill-thru.common/drill-thru-info-method query stage-number drill-thru)) | |
TODO: Different ways to apply drill-thru to a query. So far: - :filter on each :operators of :drill-thru/quick-filter applied with (lib/filter query stage filter-clause) | |
TODO: ActionMode, PublicMode, MetabotMode need to be captured in the FE before calling | |
Some drill thru functions are expected to return drills for just the specified TODO: Missing drills: format. | (def ^:private available-drill-thru-fns
[{:f #'lib.drill-thru.automatic-insights/automatic-insights-drill, :return-drills-for-dimensions? false}
{:f #'lib.drill-thru.column-filter/column-filter-drill, :return-drills-for-dimensions? true}
{:f #'lib.drill-thru.distribution/distribution-drill, :return-drills-for-dimensions? true}
{:f #'lib.drill-thru.fk-filter/fk-filter-drill, :return-drills-for-dimensions? false}
{:f #'lib.drill-thru.object-details/object-detail-drill, :return-drills-for-dimensions? false}
{:f #'lib.drill-thru.pivot/pivot-drill, :return-drills-for-dimensions? false}
{:f #'lib.drill-thru.quick-filter/quick-filter-drill, :return-drills-for-dimensions? false}
{:f #'lib.drill-thru.sort/sort-drill, :return-drills-for-dimensions? true}
{:f #'lib.drill-thru.summarize-column/summarize-column-drill, :return-drills-for-dimensions? true}
{:f #'lib.drill-thru.summarize-column-by-time/summarize-column-by-time-drill, :return-drills-for-dimensions? true}
{:f #'lib.drill-thru.underlying-records/underlying-records-drill, :return-drills-for-dimensions? false}
{:f #'lib.drill-thru.zoom-in-timeseries/zoom-in-timeseries-drill, :return-drills-for-dimensions? false}
{:f #'lib.drill-thru.zoom-in-geographic/zoom-in-geographic-drill, :return-drills-for-dimensions? true}
{:f #'lib.drill-thru.zoom-in-bins/zoom-in-binning-drill, :return-drills-for-dimensions? true}]) |
(mu/defn ^:private dimension-contexts :- [:maybe [:sequential {:min 1} ::lib.schema.drill-thru/context]]
"Create new context maps (with updated `:column` and `:value` keys) for each of the `:dimensions` passed in. Some
drill thru functions are expected to return drills for each of these columns, while others are expected to ignore
them. Why? Who knows."
[{:keys [dimensions], :as context} :- ::lib.schema.drill-thru/context]
(not-empty
(for [dimension dimensions]
(merge context dimension)))) | |
(mu/defn available-drill-thrus :- [:sequential [:ref ::lib.schema.drill-thru/drill-thru]]
"Get a list (possibly empty) of available drill-thrus for a column, or a column + value pair.
Note that if `:value nil` in the `context`, that implies the value is *missing*, ie. that this was a column click.
For a value of `NULL` from the database, use the sentinel `:null`. Most of this file only cares whether the value
was provided or not, but some things (eg. quick filters) treat `NULL` values differently.
See [[metabase.lib.js/available-drill-thrus]]."
([query context]
(available-drill-thrus query -1 context))
([query :- ::lib.schema/query
stage-number :- :int
context :- ::lib.schema.drill-thru/context]
(try
(into []
(when (lib.metadata/editable? query)
(let [dim-contexts (dimension-contexts context)]
(for [{:keys [f return-drills-for-dimensions?]} available-drill-thru-fns
context (if (and return-drills-for-dimensions? dim-contexts)
dim-contexts
[context])
:let [drill (f query stage-number context)]
:when drill]
drill))))
(catch #?(:clj Throwable :cljs :default) e
(throw (ex-info (str "Error getting available drill thrus for query: " (ex-message e))
{:query query
:stage-number stage-number
:context context}
e)))))) | |
(mu/defn drill-thru :- ::lib.schema/query
"`(drill-thru query stage-number drill-thru)`
Applies the `drill-thru` to the query and stage. Keyed on the `:type` of the drill-thru. The `drill-thru` should be
one of those returned by a call to [[available-drill-thrus]] with the same `query` and `stage-number`.
Returns the updated query."
([query drill]
(drill-thru query -1 drill))
([query :- ::lib.schema/query
stage-number :- :int
drill :- ::lib.schema.drill-thru/drill-thru
& args]
(log/debugf "Applying drill thru: %s"
(u/pprint-to-str {:query query, :stage-number stage-number, :drill drill, :args args}))
(apply lib.drill-thru.common/drill-thru-method query stage-number drill args))) | |
(ns metabase.lib.drill-thru.automatic-insights (:require [metabase.lib.drill-thru.common :as lib.drill-thru.common] [metabase.lib.drill-thru.underlying-records :as lib.drill-thru.underlying-records] [metabase.lib.metadata :as lib.metadata] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.drill-thru :as lib.schema.drill-thru] [metabase.lib.util :as lib.util] [metabase.util.malli :as mu])) | |
(mu/defn automatic-insights-drill :- [:maybe ::lib.schema.drill-thru/drill-thru]
"Automatic insights appears:
- When clicking on a value with a breakout - eg. a point in a time series, a cell of a table, a bar or pie slice
- Or when clicking a pivot cell, with a value but no column.
- Or when clicking a chart legend, in which case there's no column or value set.
- There must be at least 1 breakout
- X-rays must be enabled (check the settings)
There are two forms: X-ray, and \"Compare to the rest\". This is a simple user choice and does not need extra data."
[query :- ::lib.schema/query
stage-number :- :int
{:keys [column column-ref dimensions value]} :- ::lib.schema.drill-thru/context]
(when (and (lib.drill-thru.common/mbql-stage? query stage-number)
;; Column with no value is not allowed - that's a column header click. Other combinations are allowed.
(or (not column) (some? value))
(lib.metadata/setting query :enable-xrays)
(not-empty dimensions))
{:lib/type :metabase.lib.drill-thru/drill-thru
:type :drill-thru/automatic-insights
:column-ref column-ref
:dimensions dimensions})) | |
(defmethod lib.drill-thru.common/drill-thru-method :drill-thru/automatic-insights
[query _stage-number drill-thru & _]
;; Returns a dummy query with the right filters for the underlying query. Rather than using this query directly, the
;; FE logic for this drill will grab the filters and build a URL with them.
(-> query
;; Drop any existing filters so they aren't duplicated.
(lib.util/update-query-stage -1 dissoc :filters)
;; Then transform the aggregations and selected breakouts into filters.
(lib.drill-thru.underlying-records/drill-underlying-records drill-thru))) | |
Enables "Filter by this column" menu item. The caveat here is that for aggregation and breakout columns we need to append a stage before adding a filter. There
is a helper function called Another caveat is that we need to verify that Entry points:
Requirements:
Query transformation:
Question transformation: - None | (ns metabase.lib.drill-thru.column-filter (:require [medley.core :as m] [metabase.lib.drill-thru.common :as lib.drill-thru.common] [metabase.lib.equality :as lib.equality] [metabase.lib.filter :as lib.filter] [metabase.lib.filter.operator :as lib.filter.operator] [metabase.lib.ref :as lib.ref] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.drill-thru :as lib.schema.drill-thru] [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.lib.stage :as lib.stage] [metabase.lib.types.isa :as lib.types.isa] [metabase.lib.util :as lib.util] [metabase.util.malli :as mu])) |
(mu/defn filter-drill-adjusted-query :- [:map
[:query ::lib.schema/query]
[:stage-number :int]
[:column lib.filter/ColumnWithOperators]]
"If the column we're filtering on is an aggregation, the filtering must happen in a later stage. This function returns
a map with that possibly-updated `:query` and `:stage-number`, plus the `:column` for filtering in that stage (with
filter operators, as returned by [[lib.filter/filterable-columns]]).
If the column is an aggregation but the query already has a later stage, that stage is reused.
If the column is not an aggregation, the query and stage-number are returned unchanged, but the
[[lib.filter/filterable-columns]] counterpart of the input `column` is still returned.
This query and filterable column are exactly what the FE needs to render the filtering UI for a column filter drill,
or certain tricky cases of quick filter."
[query :- ::lib.schema/query
stage-number :- :int
column :- ::lib.schema.metadata/column]
(let [next-stage (->> (lib.util/canonical-stage-index query stage-number)
(lib.util/next-stage-number query))
base (cond
;; Not an aggregation: just the input query and stage.
(not= (:lib/source column) :source/aggregations)
{:query query
:stage-number stage-number}
;; Aggregation column: if there's a later stage, use it.
next-stage {:query query
:stage-number next-stage}
;; Aggregation column with no later stage; append a stage.
:else {:query (lib.stage/append-stage query)
:stage-number -1})
columns (lib.filter/filterable-columns (:query base) (:stage-number base))
filter-column (or (lib.equality/find-matching-column
(:query base) (:stage-number base) (lib.ref/ref column) columns)
(and (:lib/source-uuid column)
(m/find-first #(= (:lib/source-uuid %) (:lib/source-uuid column))
columns)))]
(assoc base :column filter-column))) | |
(mu/defn column-filter-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.column-filter]
"Filtering at the column level, based on its type. Displays a submenu of eg. \"Today\", \"This Week\", etc. for date
columns.
Note that if the clicked column is an aggregation, filtering by it will require a new stage. Therefore this drill
returns a possibly-updated `:query` and `:stage-number` along with a `:column` referencing that later stage."
[query :- ::lib.schema/query
stage-number :- :int
{:keys [column value]} :- ::lib.schema.drill-thru/context]
;; Note: original code uses an addition `clicked.column.field_ref != null` condition.
(when (and (lib.drill-thru.common/mbql-stage? query stage-number)
column
(nil? value)
(not (lib.types.isa/structured? column)))
(let [initial-op (when-not (lib.types.isa/temporal? column) ; Date fields have special handling in the FE.
(-> (lib.filter.operator/filter-operators column)
first
(assoc :lib/type :operator/filter)))]
(merge
{:lib/type :metabase.lib.drill-thru/drill-thru
:type :drill-thru/column-filter
:initial-op initial-op}
;; When the column we would be filtering on is an aggregation, it can't be filtered without adding a stage.
(filter-drill-adjusted-query query stage-number column))))) | |
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/column-filter
[_query _stage-number {:keys [initial-op]}]
{:type :drill-thru/column-filter
:initial-op initial-op}) | |
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/column-filter :- ::lib.schema/query
[query :- ::lib.schema/query
stage-number :- :int
{:keys [column] :as _drill-thru} :- ::lib.schema.drill-thru/drill-thru.column-filter
filter-op :- [:or :keyword :string] ; filter tag
value :- :any]
(lib.filter/filter query stage-number (lib.filter/filter-clause filter-op column value))) | |
(ns metabase.lib.drill-thru.common (:require [metabase.lib.hierarchy :as lib.hierarchy] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.util :as lib.util])) | |
Is this query stage an MBQL stage? | (defn mbql-stage?
[query stage-number]
(-> (lib.util/query-stage query stage-number)
:lib/type
(= :mbql.stage/mbql))) |
(defn- drill-thru-dispatch [_query _stage-number drill-thru & _args] (:type drill-thru)) | |
e.g. (drill-thru-method query stage-number drill-thru)` Applies the | (defmulti drill-thru-method
{:arglists '([query stage-number drill-thru & args])}
drill-thru-dispatch
:hierarchy lib.hierarchy/hierarchy) |
Helper for getting the display-info of each specific type of drill-thru. | (defmulti drill-thru-info-method
{:arglists '([query stage-number drill-thru])}
drill-thru-dispatch
:hierarchy lib.hierarchy/hierarchy) |
(defmethod drill-thru-info-method :default [_query _stage-number drill-thru] ;; Several drill-thrus are rendered as a fixed label for that type, with no reference to the column or value, ;; so the default is simply the drill-thru type. (select-keys drill-thru [:type :display-name])) | |
Does the source table for this | (defn many-pks? [query] (> (count (lib.metadata.calculation/primary-keys query)) 1)) |
Raw data with a breakout based on the selected column. For date columns, sets "Month" as a temporal unit. For numeric columns, uses the default binning strategy. Other columns are not changed. Entry points:
Requirements:
Query transformation (last stage only):
Question transformation:
| (ns metabase.lib.drill-thru.distribution (:require [metabase.lib.aggregation :as lib.aggregation] [metabase.lib.binning :as lib.binning] [metabase.lib.breakout :as lib.breakout] [metabase.lib.drill-thru.common :as lib.drill-thru.common] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.drill-thru :as lib.schema.drill-thru] [metabase.lib.temporal-bucket :as lib.temporal-bucket] [metabase.lib.types.isa :as lib.types.isa] [metabase.lib.util :as lib.util] [metabase.util.malli :as mu])) |
TODO: The original | (mu/defn distribution-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.distribution]
"Select a column and see a histogram of how many rows fall into an automatic set of bins/buckets.
- For dates, breaks out by month by default.
- For numeric values, by an auto-selected set of bins
- For strings, by each distinct value (which might be = the number of rows)"
[query :- ::lib.schema/query
stage-number :- :int
{:keys [column value]} :- ::lib.schema.drill-thru/context]
(when (and (lib.drill-thru.common/mbql-stage? query stage-number)
column
(nil? value)
(not= (:lib/source column) :source/aggregations)
(not (lib.types.isa/primary-key? column))
(not (lib.types.isa/structured? column))
(not (lib.types.isa/comment? column))
(not (lib.types.isa/description? column))
(not (lib.breakout/breakout-column? query stage-number column)))
{:lib/type :metabase.lib.drill-thru/drill-thru
:type :drill-thru/distribution
:column column})) |
(defn- add-temporal-bucketing-or-binning
[column]
(cond
(lib.types.isa/temporal? column)
(lib.temporal-bucket/with-temporal-bucket column :month)
(and (lib.types.isa/numeric? column)
(not (lib.types.isa/foreign-key? column)))
(lib.binning/with-binning column (lib.binning/default-auto-bin))
:else
column)) | |
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/distribution :- ::lib.schema/query
[query :- ::lib.schema/query
stage-number :- :int
{:keys [column] :as _drill-thru} :- ::lib.schema.drill-thru/drill-thru.distribution]
(when (lib.drill-thru.common/mbql-stage? query stage-number)
(let [breakout (add-temporal-bucketing-or-binning column)]
(-> query
;; Remove most of the target stage.
(lib.util/update-query-stage stage-number dissoc :aggregation :breakout :limit :order-by)
;; Then set a count aggregation and the breakout above.
(lib.aggregation/aggregate stage-number (lib.aggregation/count))
(lib.breakout/breakout stage-number breakout))))) | |
Object details drill for FK fields. Creates a new query based on the FK table with a Entry points:
Requirements:
Query transformation:
Question transformation:
An FK details drill is one where you click a foreign key value in a table view e.g. ORDERS.USER_ID and choose the 'View details' option, then it shows you the PEOPLE record in question (e.g. Person 5 if USER_ID was 5). We will only possibly return one of the 'object details' drills ([[metabase.lib.drill-thru.pk]], [[metabase.lib.drill-thru.fk-details]], or [[metabase.lib.drill-thru.zoom]]); see [[metabase.lib.drill-thru.object-details]] for the high-level logic that calls out to the individual implementations. | (ns metabase.lib.drill-thru.fk-details (:require [metabase.lib.drill-thru.common :as lib.drill-thru.common] [metabase.lib.filter :as lib.filter] [metabase.lib.metadata :as lib.metadata] [metabase.lib.query :as lib.query] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.drill-thru :as lib.schema.drill-thru] [metabase.lib.types.isa :as lib.types.isa] [metabase.util.malli :as mu])) |
(mu/defn fk-details-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.fk-details]
"Return an `:fk-details` 'View details' drill when clicking on the value of a FK column."
[query :- ::lib.schema/query
_stage-number :- :int
{:keys [column value] :as _context} :- ::lib.schema.drill-thru/context]
(when (and (lib.types.isa/foreign-key? column)
(some? value)
(not= value :null))
{:lib/type :metabase.lib.drill-thru/drill-thru
:type :drill-thru/fk-details
:column column
:object-id value
:many-pks? (lib.drill-thru.common/many-pks? query)})) | |
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/fk-details [_query _stage-number drill-thru] (select-keys drill-thru [:many-pks? :object-id :type])) | |
(defmethod lib.drill-thru.common/drill-thru-method :drill-thru/fk-details
[query stage-number {:keys [column object-id]} & _]
;; generate a NEW query against the FK target table and column, e.g. if the original query was
;; ORDERS/ORDERS.USER_ID, the new query should by PEOPLE/PEOPLE.ID.
(let [fk-column-id (:fk-target-field-id column)
fk-column (some->> fk-column-id (lib.metadata/field query))
fk-column-table (some->> (:table-id fk-column) (lib.metadata/table query))]
(-> (lib.query/query query fk-column-table)
(lib.filter/filter stage-number (lib.filter/= fk-column object-id))))) | |
Adds a simple Entry points:
Requirements:
Query transformation:
Question transformation: - None | (ns metabase.lib.drill-thru.fk-filter (:require [metabase.lib.drill-thru.common :as lib.drill-thru.common] [metabase.lib.filter :as lib.filter] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.options :as lib.options] [metabase.lib.ref :as lib.ref] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.drill-thru :as lib.schema.drill-thru] [metabase.lib.types.isa :as lib.types.isa] [metabase.lib.util :as lib.util] [metabase.util.malli :as mu])) |
(mu/defn fk-filter-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.fk-filter]
"When clicking on a foreign key value, filter this query by that column.
This has the same effect as the `=` filter on a generic field (ie. not a key), but renders differently.
Contrast [[metabase.lib.drill-thru.object-details/object-detail-drill]], which shows the details of the foreign
object."
[query :- ::lib.schema/query
stage-number :- :int
{:keys [column value], :as _context} :- ::lib.schema.drill-thru/context]
(when (and column
(some? value)
(not= value :null) ; If the FK is null, don't show this option.
(lib.drill-thru.common/mbql-stage? query stage-number)
(not (lib.types.isa/primary-key? column))
(lib.types.isa/foreign-key? column))
(let [source (or (some->> query lib.util/source-table-id (lib.metadata/table query))
(some->> query lib.util/source-card-id (lib.metadata/card query)))]
{:lib/type :metabase.lib.drill-thru/drill-thru
:type :drill-thru/fk-filter
:filter (lib.options/ensure-uuid [:= {} (lib.ref/ref column) value])
:column-name (lib.metadata.calculation/display-name query stage-number column :long)
:table-name (lib.metadata.calculation/display-name query 0 source)}))) | |
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/fk-filter [_query _stage-number drill-thru] (select-keys drill-thru [:type :column-name :table-name])) | |
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/fk-filter :- ::lib.schema/query
[query :- ::lib.schema/query
stage-number :- :int
drill-thru :- ::lib.schema.drill-thru/drill-thru.fk-filter
& _args]
;; if the stage in question is an MBQL stage, we can simply add a `=` filter to it. If it's a native stage, we have
;; to apply the drill to the stage after that stage, which will be an MBQL stage, adding it if needed (native stages
;; are currently only allowed to be the first stage.)
(let [[query stage-number] (if (lib.drill-thru.common/mbql-stage? query stage-number)
[query stage-number]
;; native stage
(let [;; convert the stage number e.g. `-1` to the canonical non-relative stage number
stage-number (lib.util/canonical-stage-index query stage-number)
;; make sure the query has at least one MBQL stage after the native stage, which we
;; know is the first stage.
query (lib.util/ensure-mbql-final-stage query)
next-stage-number (lib.util/next-stage-number query stage-number)]
(assert (lib.util/query-stage query next-stage-number)
"Sanity check: there should be an additional stage by now")
[query next-stage-number]))]
(lib.filter/filter query stage-number (:filter drill-thru)))) | |
(ns metabase.lib.drill-thru.object-details (:require [metabase.lib.drill-thru.fk-details :as lib.drill-thru.fk-details] [metabase.lib.drill-thru.pk :as lib.drill-thru.pk] [metabase.lib.drill-thru.zoom :as lib.drill-thru.zoom] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.drill-thru :as lib.schema.drill-thru] [metabase.util.malli :as mu])) | |
(mu/defn object-detail-drill :- [:maybe [:or
::lib.schema.drill-thru/drill-thru.pk
::lib.schema.drill-thru/drill-thru.zoom
::lib.schema.drill-thru/drill-thru.fk-details]]
"When clicking a foreign key or primary key value, drill through to the details for that specific object.
Contrast [[metabase.lib.drill-thru.fk-filter/fk-filter-drill]], which filters this query to only those rows with a
specific value for a FK column."
[query :- ::lib.schema/query
stage-number :- :int
context :- ::lib.schema.drill-thru/context]
(some (fn [f]
(f query stage-number context))
[lib.drill-thru.fk-details/fk-details-drill
lib.drill-thru.pk/pk-drill
lib.drill-thru.zoom/zoom-drill])) | |
"Breakout by" transform. Entry points:
Requirements:
For different query types/shapes different breakout columns are allowed:
Query transformation is similar to
Question transformation:
Other functions:
| (ns metabase.lib.drill-thru.pivot (:require [metabase.lib.aggregation :as lib.aggregation] [metabase.lib.breakout :as lib.breakout] [metabase.lib.drill-thru.common :as lib.drill-thru.common] [metabase.lib.filter :as lib.filter] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.drill-thru :as lib.schema.drill-thru] [metabase.lib.types.isa :as lib.types.isa] [metabase.util.malli :as mu])) |
(mu/defn ^:private pivot-drill-pred :- [:sequential lib.metadata/ColumnMetadata]
"Implementation for pivoting on various kinds of fields.
Don't call this directly; call [[pivot-drill]]."
[query :- ::lib.schema/query
stage-number :- :int
{:keys [column value]} :- ::lib.schema.drill-thru/context
field-pred :- [:=> [:cat lib.metadata/ColumnMetadata] boolean?]]
(when (and (lib.drill-thru.common/mbql-stage? query stage-number)
column
(some? value)
(= (:lib/source column) :source/aggregations))
(->> (lib.breakout/breakoutable-columns query stage-number)
(filter field-pred)))) | |
(def ^:private pivot-type-predicates
{:category (every-pred lib.types.isa/category?
(complement lib.types.isa/address?))
:location lib.types.isa/address?
:time lib.types.isa/temporal?}) | |
(defn- breakout-type [query stage-number breakout]
(let [column (lib.metadata.calculation/metadata query stage-number breakout)]
(cond
(lib.types.isa/temporal? column) :date
(lib.types.isa/address? column) :address
(lib.types.isa/category? column) :category))) | |
(mu/defn ^:private permitted-pivot-types :- [:maybe [:set ::lib.schema.drill-thru/pivot-types]]
"This captures some complex conditions formerly encoded by `visualizations/click-actions/Mode/*` in the FE.
See [here](https://github.com/metabase/metabase/blob/f4415fec8563353615ef600f52de871507a052ec/frontend/src/metabase/visualizations/click-actions/Mode/utils.ts#L15)
for the original logic. (It returns `MODE_TYPE_*` enums, which are referenced below.)
Pivot drills are only available in certain conditions, like all drills: structured queries with aggregation(s), when
clicking a specific cell.
- No breakouts: any pivot is permitted. (`metric` mode)
- Exactly one date breakout, with an optional category breakout: no `:time` pivot. (`timeseries` mode)
- Exactly one breakout and it's an address: no `:location` pivot. (`geo` mode)
- One or two category breakouts: no `:location` pivot. (`pivot` mode)
- If all these conditions fail, no pivots are allowed and the pivot drill should not be returned.
This function encodes all these rules, returning a (possibly emtpy) set of permitted types."
[query :- ::lib.schema/query
stage-number :- :int]
(case (->> (lib.breakout/breakouts query stage-number)
(map #(breakout-type query stage-number %))
frequencies)
({:date 1}
{:date 1, :category 1})
#{:category :location}
{:address 1}
#{:category :time}
{}
#{:category :location :time}
({:category 1} {:category 2})
#{:category :time}
;; If there are breakouts but none of those conditions matched, no pivots are permitted.
#{})) | |
(mu/defn pivot-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.pivot]
"Return all possible pivoting options on the given column and value.
See `:pivots` key, which holds a map `{t [breakouts...]}` where `t` is `:category`, `:location`, or `:time`.
If a key is missing, there are no breakouts of that kind."
[query :- ::lib.schema/query
stage-number :- :int
{:keys [column dimensions value] :as context} :- ::lib.schema.drill-thru/context]
(when (and (lib.drill-thru.common/mbql-stage? query stage-number)
column
(some? value)
(= (:lib/source column) :source/aggregations)
(-> (lib.aggregation/aggregations query stage-number) count pos?))
(let [breakout-pivot-types (permitted-pivot-types query stage-number)
pivots (into {} (for [pivot-type breakout-pivot-types
:let [pred (get pivot-type-predicates pivot-type)
columns (pivot-drill-pred query stage-number context pred)]
:when (not-empty columns)]
[pivot-type columns]))]
(when-not (empty? pivots)
{:lib/type :metabase.lib.drill-thru/drill-thru
:type :drill-thru/pivot
:dimensions dimensions
:pivots pivots})))) | |
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/pivot [_query _stage-number drill-thru] (select-keys drill-thru [:many-pks? :object-id :type])) | |
Note that pivot drills have specific public functions for accessing the nested pivoting options.
Therefore the [[drill-thru-info-method]] is just the default | |
(mu/defn pivot-types :- [:sequential ::lib.schema.drill-thru/pivot-types]
"A helper for the FE. Returns the set of pivot types (category, location, time) that apply to this drill-thru."
[drill-thru :- [:and ::lib.schema.drill-thru/drill-thru
[:map [:type [:= :drill-thru/pivot]]]]]
(-> drill-thru :pivots keys sort)) | |
(mu/defn pivot-columns-for-type :- [:sequential lib.metadata/ColumnMetadata]
"A helper for the FE. Returns all the columns of the given type which can be used to pivot the query."
[drill-thru :- [:and ::lib.schema.drill-thru/drill-thru
[:map [:type [:= :drill-thru/pivot]]]]
pivot-type :- ::lib.schema.drill-thru/pivot-types]
(get-in drill-thru [:pivots pivot-type])) | |
(defn- breakouts->filters [query stage-number {:keys [column value] :as _dimension}]
(-> query
(lib.breakout/remove-existing-breakouts-for-column stage-number column)
(lib.filter/filter stage-number (lib.filter/= column value)))) | |
Pivot drills are in play when clicking an aggregation cell. Pivoting is applied by: 1. For each "dimension", ie. the specific values for all breakouts at the originally clicked cell: a. Filter the query to have the dimension's column = the dimension's value at that cell. b. Go through the breakouts, and remove any that match this dimension from the query. 2. Add a new breakout for the selected column. | (defmethod lib.drill-thru.common/drill-thru-method :drill-thru/pivot
[query stage-number drill-thru & [column]]
(let [filtered (reduce #(breakouts->filters %1 stage-number %2) query (:dimensions drill-thru))]
(lib.breakout/breakout filtered stage-number column))) |
Object details drill for cases when there is multiple PK columns. Entry points:
Requirements:
Query transformation:
Question transformation:
A We will only possibly return one of the 'object details' drills ([[metabase.lib.drill-thru.pk]], [[metabase.lib.drill-thru.fk-details]], or [[metabase.lib.drill-thru.zoom]]); see [[metabase.lib.drill-thru.object-details]] for the high-level logic that calls out to the individual implementations. | (ns metabase.lib.drill-thru.pk (:require [medley.core :as m] [metabase.lib.drill-thru.common :as lib.drill-thru.common] [metabase.lib.filter :as lib.filter] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.drill-thru :as lib.schema.drill-thru] [metabase.lib.types.isa :as lib.types.isa] [metabase.util.malli :as mu])) |
(mu/defn pk-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.pk]
"'View details' drill when you click on a value in a table that has MULTIPLE PKs. There are two subtypes of PK
drills:
1) if you click on a PK column value, then we return a drill that will add a filter for that PK column/value
2) if you click a non-PK column value, then we return a drill that will add filters for the PK columns/values in the
row. This is never returned for FK columns; we return [[metabase.lib.drill-thru.fk-details]] drills instead."
[query :- ::lib.schema/query
stage-number :- :int
{:keys [column value row] :as _context} :- ::lib.schema.drill-thru/context]
(when (and
;; ignore column header clicks (value = nil). NULL values (value = :null) are ok if this is a click on a
;; non-PK column.
(some? value)
(lib.drill-thru.common/mbql-stage? query stage-number)
;; `:pk` drills are only for Tables with multiple PKs. For Tables with one PK, we do
;; a [[metabase.lib.drill-thru.zoom]] drill instead.
(lib.drill-thru.common/many-pks? query)
;; if this is an FK column we should return an [[metabase.lib.drill-thru.fk-details]] drill instead.
(not (lib.types.isa/foreign-key? column)))
(if (lib.types.isa/primary-key? column)
;; 1) we clicked on a PK column: return a drill thru for that PK column + value. Ignore `nil` values.
(when (and (some? value)
(not= value :null))
{:lib/type :metabase.lib.drill-thru/drill-thru
:type :drill-thru/pk
:dimensions [{:column column
:value value}]})
;; 2) we clicked on a non-PK column: return a drill for ALL of the PK columns + values. Ignore any
;; `nil` (`:null`) values.
(let [pk-columns (lib.metadata.calculation/primary-keys query)
dimensions (for [pk-column pk-columns
:let [value (->> row
(m/find-first #(-> % :column :name (= (:name pk-column))))
:value)]
;; ignore any PKs that don't have a value in this row.
:when value]
{:column pk-column, :value value})]
(when (seq dimensions)
{:lib/type :metabase.lib.drill-thru/drill-thru
:type :drill-thru/pk
;; return the dimensions sorted by column ID so the return value is determinate.
:dimensions (vec (sort-by #(get-in % [:column :id]) dimensions))}))))) | |
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/pk [_query _stage-number drill-thru] (select-keys drill-thru [:type :dimensions])) | |
(defmethod lib.drill-thru.common/drill-thru-method :drill-thru/pk
[query stage-number {:keys [dimensions], :as _pk-drill}]
(reduce
(fn [query {:keys [column value], :as _dimension}]
(lib.filter/filter query stage-number (lib.filter/= column value)))
query
dimensions)) | |
Adds a filter clause with simple operators like Entry points:
Requirements:
Query transformation:
Question transformation:
There is a separate function | (ns metabase.lib.drill-thru.quick-filter (:require [medley.core :as m] [metabase.lib.drill-thru.column-filter :as lib.drill-thru.column-filter] [metabase.lib.drill-thru.common :as lib.drill-thru.common] [metabase.lib.filter :as lib.filter] [metabase.lib.metadata :as lib.metadata] [metabase.lib.options :as lib.options] [metabase.lib.ref :as lib.ref] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.drill-thru :as lib.schema.drill-thru] [metabase.lib.schema.expression :as lib.schema.expression] [metabase.lib.types.isa :as lib.types.isa] [metabase.util.malli :as mu])) |
(defn- operator [op & args]
(lib.options/ensure-uuid (into [op {}] args))) | |
(mu/defn ^:private operators-for :- [:sequential ::lib.schema.drill-thru/drill-thru.quick-filter.operator]
[column :- lib.metadata/ColumnMetadata
value]
(let [field-ref (lib.ref/ref column)]
(cond
(lib.types.isa/structured? column)
[]
(= value :null)
[{:name "=" :filter (operator :is-null field-ref)}
{:name "≠" :filter (operator :not-null field-ref)}]
(or (lib.types.isa/numeric? column)
(lib.types.isa/temporal? column))
(for [[op label] [[:< "<"]
[:> ">"]
[:= "="]
[:!= "≠"]]
:when (or (not (#{:< :>} op))
(lib.schema.expression/comparable-expressions? field-ref value))]
{:name label
:filter (operator op field-ref value)})
(and (lib.types.isa/string? column)
(or (lib.types.isa/comment? column)
(lib.types.isa/description? column)))
(for [[op label] [[:contains "contains"]
[:does-not-contain "does-not-contain"]]]
{:name label
:filter (operator op field-ref value)})
:else
(for [[op label] [[:= "="]
[:!= "≠"]]]
{:name label
:filter (operator op field-ref value)})))) | |
(mu/defn quick-filter-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.quick-filter]
"Filter the current query based on the value clicked.
The options vary depending on the type of the field:
- `:is-null` and `:not-null` for a `NULL` value;
- `:=` and `:!=` for everything else;
- plus `:<` and `:>` for numeric and date columns.
Note that this returns a single `::drill-thru` value with 1 or more `:operators`; these are rendered as a set of small
buttons in a single row of the drop-down."
[query :- ::lib.schema/query
stage-number :- :int
{:keys [column value], :as _context} :- ::lib.schema.drill-thru/context]
(when (and (lib.drill-thru.common/mbql-stage? query stage-number)
column
(some? value) ; Deliberately allows value :null, only a missing value should fail this test.
(not (lib.types.isa/primary-key? column))
(not (lib.types.isa/foreign-key? column)))
;; For aggregate columns, we want to introduce a new stage when applying the drill-thru.
;; [[lib.drill-thru.column-filter/filter-drill-adjusted-query]] handles this. (#34346)
(let [adjusted (lib.drill-thru.column-filter/filter-drill-adjusted-query query stage-number column)]
(merge {:lib/type :metabase.lib.drill-thru/drill-thru
:type :drill-thru/quick-filter
:operators (operators-for (:column adjusted) value)
:value value}
adjusted)))) | |
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/quick-filter
[_query _stage-number drill-thru]
(-> (select-keys drill-thru [:type :operators :value])
(update :operators (fn [operators]
(mapv :name operators))))) | |
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/quick-filter :- ::lib.schema/query
[_query :- ::lib.schema/query
_stage-number :- :int
{:keys [query stage-number]
:as drill} :- ::lib.schema.drill-thru/drill-thru.quick-filter
filter-op :- ::lib.schema.common/non-blank-string]
(let [quick-filter (or (m/find-first #(= (:name %) filter-op) (:operators drill))
(throw (ex-info (str "No matching filter for operator " filter-op)
{:drill-thru drill
:operator filter-op
:query query
:stage-number stage-number})))]
(lib.filter/filter query stage-number (:filter quick-filter)))) | |
Adds an order by clause on the selected column. Entry points:
Requirements:
Query transformation:
Question transformation:
| (ns metabase.lib.drill-thru.sort (:require [medley.core :as m] [metabase.lib.drill-thru.common :as lib.drill-thru.common] [metabase.lib.equality :as lib.equality] [metabase.lib.order-by :as lib.order-by] [metabase.lib.ref :as lib.ref] [metabase.lib.remove-replace :as lib.remove-replace] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.drill-thru :as lib.schema.drill-thru] [metabase.lib.schema.order-by :as lib.schema.order-by] [metabase.lib.types.isa :as lib.types.isa] [metabase.util.malli :as mu])) |
Is | (defn- orderable-column?
[query stage-number column]
(lib.equality/find-matching-column query
stage-number
(lib.ref/ref column)
(lib.order-by/orderable-columns query stage-number))) |
(mu/defn ^:private existing-order-by-clause :- [:maybe ::lib.schema.order-by/order-by]
[query stage-number column]
(m/find-first (fn [[_direction _opts expr, :as _asc-or-desc-clause]]
(lib.equality/find-matching-column query stage-number expr [column]))
(lib.order-by/order-bys query stage-number))) | |
(mu/defn ^:private existing-order-by-direction :- [:maybe ::lib.schema.order-by/direction]
[query stage-number column]
(when-let [[direction _opts _expr] (existing-order-by-clause query stage-number column)]
direction)) | |
(mu/defn sort-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.sort]
"Sorting on a clicked column."
[query :- ::lib.schema/query
stage-number :- :int
{:keys [column value], :as _context} :- ::lib.schema.drill-thru/context]
;; if we have a context with a `:column`, but no `:value`...
(when (and (lib.drill-thru.common/mbql-stage? query stage-number)
column
(nil? value)
(not (lib.types.isa/structured? column)))
;; ...and the column is orderable, we can return a sort drill-thru.
(when (orderable-column? query stage-number column)
;; check and see if there is already a sort on this column. If there is, we should only suggest flipping the
;; direction to the opposite of what it is now. If there is no existing sort, then return both directions as
;; options.
(let [existing-direction (existing-order-by-direction query stage-number column)]
{:lib/type :metabase.lib.drill-thru/drill-thru
:type :drill-thru/sort
:column column
:sort-directions (case existing-direction
:asc [:desc]
:desc [:asc]
[:asc :desc])})))) | |
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/sort
([query stage-number drill]
(lib.drill-thru.common/drill-thru-method query stage-number drill :asc))
([query :- ::lib.schema/query
stage-number :- :int
{:keys [column], :as _drill} :- ::lib.schema.drill-thru/drill-thru.sort
direction :- ::lib.schema.order-by/direction]
;; if you have an existing order by, the drill thru returned by [[sort-drill]] would only be one that would suggest
;; changing it to the opposite direction, so we can safely assume we want to change the direction and
;; use [[lib.order-by/change-direction]] here.
(if-let [existing-clause (existing-order-by-clause query stage-number column)]
(lib.remove-replace/replace-clause query existing-clause (lib.order-by/order-by-clause column (keyword direction)))
(lib.order-by/order-by query stage-number column (keyword direction))))) | |
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/sort
[_query _stage-number {directions :sort-directions}]
{:type :drill-thru/sort
:directions directions}) | |
Adds an aggregation clause based on the selected column. Could be either Entry points:
Requirements:
Query transformation:
Question transformation:
| (ns metabase.lib.drill-thru.summarize-column (:require [metabase.lib.aggregation :as lib.aggregation] [metabase.lib.breakout :as lib.breakout] [metabase.lib.drill-thru.common :as lib.drill-thru.common] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.drill-thru :as lib.schema.drill-thru] [metabase.lib.types.isa :as lib.types.isa] [metabase.util.malli :as mu])) |
(mu/defn summarize-column-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.summarize-column]
"A set of possible aggregations that can summarize this column: distinct values, sum, average.
Separate from [[summarize-column-by-time-drill]] which breaks out a column over time."
[query :- ::lib.schema/query
stage-number :- :int
{:keys [column value]} :- ::lib.schema.drill-thru/context]
(when (and (lib.drill-thru.common/mbql-stage? query stage-number)
column
(nil? value)
(not (lib.types.isa/structured? column))
(not= (:lib/source column) :source/aggregations)
(not (lib.breakout/breakout-column? query stage-number column)))
;; I'm not really super clear on how the FE is supposed to be able to display these.
(let [aggregation-ops (concat [:distinct]
(when (lib.types.isa/summable? column)
[:sum :avg]))]
{:lib/type :metabase.lib.drill-thru/drill-thru
:type :drill-thru/summarize-column
:column column
:aggregations aggregation-ops}))) | |
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/summarize-column
[_query _stage-number {:keys [aggregations]}]
{:type :drill-thru/summarize-column
:aggregations aggregations}) | |
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/summarize-column :- ::lib.schema/query
[query :- ::lib.schema/query
stage-number :- :int
{:keys [column] :as _drill-thru} :- ::lib.schema.drill-thru/drill-thru.summarize-column
aggregation :- [:or
::lib.schema.drill-thru/drill-thru.summarize-column.aggregation-type
;; I guess we'll be ok with strings too for now.
[:enum "distinct" "sum" "avg"]]]
;; TODO: The original FE code for this does `setDefaultDisplay` as well.
(let [aggregation-fn (case (keyword aggregation)
:distinct lib.aggregation/distinct
:sum lib.aggregation/sum
:avg lib.aggregation/avg)]
(lib.aggregation/aggregate query stage-number (aggregation-fn column)))) | |
Adds a Entry points:
Requirements:
Query transformation:
Question transformation:
| (ns metabase.lib.drill-thru.summarize-column-by-time (:require [medley.core :as m] [metabase.lib.aggregation :as lib.aggregation] [metabase.lib.breakout :as lib.breakout] [metabase.lib.drill-thru.common :as lib.drill-thru.common] [metabase.lib.ref :as lib.ref] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.drill-thru :as lib.schema.drill-thru] [metabase.lib.schema.util :as lib.schema.util] [metabase.lib.temporal-bucket :as lib.temporal-bucket] [metabase.lib.types.isa :as lib.types.isa] [metabase.util.malli :as mu])) |
(mu/defn summarize-column-by-time-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.summarize-column-by-time]
"A breakout summarizing a column over time.
Separate from single-value [[summarize-column-drill]] for sum, average, and distinct value count."
[query :- ::lib.schema/query
stage-number :- :int
{:keys [column value]} :- ::lib.schema.drill-thru/context]
(when (and (lib.drill-thru.common/mbql-stage? query stage-number)
column
(nil? value)
(not (lib.types.isa/structured? column))
(lib.types.isa/summable? column)
(not= (:lib/source column) :source/aggregations))
;; There must be a date dimension available.
(when-let [breakout-column (m/find-first lib.types.isa/temporal?
(lib.breakout/breakoutable-columns query stage-number))]
(when-let [bucketing-unit (m/find-first :default
(lib.temporal-bucket/available-temporal-buckets query stage-number breakout-column))]
;; only suggest this drill thru if the breakout it would apply does not already exist.
(let [bucketed (lib.temporal-bucket/with-temporal-bucket breakout-column bucketing-unit)]
(when (lib.schema.util/distinct-refs? (map lib.ref/ref (cons bucketed (lib.breakout/breakouts query stage-number))))
{:lib/type :metabase.lib.drill-thru/drill-thru
:type :drill-thru/summarize-column-by-time
:column column
:breakout breakout-column
:unit (lib.temporal-bucket/raw-temporal-bucket bucketing-unit)})))))) | |
(defmethod lib.drill-thru.common/drill-thru-method :drill-thru/summarize-column-by-time
[query stage-number {:keys [breakout column unit] :as _drill-thru} & _]
(let [bucketed (lib.temporal-bucket/with-temporal-bucket breakout unit)]
(-> query
(lib.aggregation/aggregate stage-number (lib.aggregation/sum column))
(lib.breakout/breakout stage-number bucketed)))) | |
"View these Orders" transformation. Entry points:
Requirements:
Query transformation:
Question transformation:
| (ns metabase.lib.drill-thru.underlying-records (:require [medley.core :as m] [metabase.lib.aggregation :as lib.aggregation] [metabase.lib.binning :as lib.binning] [metabase.lib.convert :as lib.convert] [metabase.lib.drill-thru.common :as lib.drill-thru.common] [metabase.lib.filter :as lib.filter] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.options :as lib.options] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.drill-thru :as lib.schema.drill-thru] [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.lib.temporal-bucket :as lib.temporal-bucket] [metabase.lib.types.isa :as lib.types.isa] [metabase.lib.underlying :as lib.underlying] [metabase.lib.util :as lib.util] [metabase.util.malli :as mu])) |
(mu/defn underlying-records-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.underlying-records]
"When clicking on a particular broken-out group, offer a look at the details of all the rows that went into this
bucket. Eg. distribution of People by State, then click New York and see the table of all People filtered by
`STATE = 'New York'`.
There is another quite different case: clicking the legend of a chart with multiple bars or lines broken out by
category. Then `column` is nil!"
[query :- ::lib.schema/query
stage-number :- :int
{:keys [column column-ref dimensions value], :as _context} :- ::lib.schema.drill-thru/context]
;; Clicking on breakouts is weird. Clicking on Count(People) by State: Minnesota yields a FE `clicked` with:
;; - column is COUNT
;; - row[0] has col: STATE, value: "Minnesota"
;; - row[1] has col: count (source: "aggregation")
;; - dimensions which is [{column: STATE, value: "MN"}]
;; - value: the aggregated value (the count, the sum, etc.)
;; So dimensions is exactly what we want.
;; It returns the table name and row count, since that's used for pluralization of the name.
;; Clicking on a chart legend for eg. COUNT(Orders) by Products.CATEGORY and Orders.CREATED_AT has a context like:
;; - column is nil
;; - value is nil
;; - dimensions holds only the legend's column, eg. Products.CATEGORY.
(when (and (lib.drill-thru.common/mbql-stage? query stage-number)
(not-empty dimensions)
;; Either we need both column and value (cell/map/data point click) or neither (chart legend click).
(or (and column (some? value))
(and (nil? column) (nil? value)))
;; If the column exists, it must not be a structured column like JSON.
(not (and column (lib.types.isa/structured? column))))
{:lib/type :metabase.lib.drill-thru/drill-thru
:type :drill-thru/underlying-records
;; TODO: This is a bit confused for non-COUNT aggregations. Perhaps it should just always be 10 or something?
;; Note that some languages have different plurals for exactly 2, or for 1, 2-5, and 6+.
:row-count (if (and (number? value)
(not (neg? value)))
value
2)
:table-name (when-let [table-or-card (or (some->> query lib.util/source-table-id (lib.metadata/table query))
(some->> query lib.util/source-card-id (lib.metadata/card query)))]
(lib.metadata.calculation/display-name query stage-number table-or-card))
:dimensions dimensions
:column-ref column-ref})) | |
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/underlying-records
[_query _stage-number {:keys [row-count table-name]}]
{:type :drill-thru/underlying-records
:row-count row-count
:table-name table-name}) | |
(mu/defn ^:private drill-filter :- ::lib.schema/query
[query :- ::lib.schema/query
stage-number :- :int
column :- ::lib.schema.metadata/column
value :- :any]
(let [filter-clauses (or (when (lib.binning/binning column)
(let [unbinned-column (lib.binning/with-binning column nil)]
(if (some? value)
(when-let [{:keys [min-value max-value]} (lib.binning/resolve-bin-width query column value)]
[(lib.filter/>= unbinned-column min-value)
(lib.filter/< unbinned-column max-value)])
[(lib.filter/is-null unbinned-column)])))
;; if the column was temporally bucketed in the top level, make sure the `=` filter we
;; generate still has that bucket. Otherwise the filter will be something like
;;
;; col = March 2023
;;
;; instead of
;;
;; month(col) = March 2023
(let [column (if-let [temporal-unit (::lib.underlying/temporal-unit column)]
(lib.temporal-bucket/with-temporal-bucket column temporal-unit)
column)]
[(lib.filter/= column value)]))]
(reduce
(fn [query filter-clause]
(lib.filter/filter query stage-number filter-clause))
query
filter-clauses))) | |
Drops aggregations, breakouts, orders, limits and field, then applies a filter for each of the dimensions (including
for metrics, and aggregations that imply a filter like Extracted to a helper since it's reused by automatic-insights drill. | (defn drill-underlying-records
[query {:keys [column-ref dimensions] :as _context}]
(let [;; Drop all aggregations, breakouts, sort orders, etc. to get the underlying records.
;; Note that all operations are performed on the final stage of input query.
base-query (lib.util/update-query-stage query -1 dissoc :aggregation :breakout :order-by :limit :fields)
;; Turn any non-aggregation dimensions into filters.
;; eg. if we drilled into a temporal bucket, add a filter for the [:= breakout-column that-month].
filtered (reduce (fn [q {:keys [column value]}]
(drill-filter q -1 column value))
base-query
(for [dimension dimensions
:when (-> dimension :column :lib/source (not= :source/aggregations))]
dimension))
;; The column-ref should be an aggregation ref - look up the full aggregation.
aggregation (when-let [agg-uuid (last column-ref)]
(m/find-first #(= (lib.options/uuid %) agg-uuid)
(lib.aggregation/aggregations query -1)))]
;; Apply the filters derived from the aggregation.
(reduce #(lib.filter/filter %1 -1 %2)
filtered
;; If we found an aggregation, check if it implies further filtering.
;; Simple aggregations like :sum don't add more filters; metrics or fancy aggregations like :sum-where do.
(when aggregation
(case (first aggregation)
;; Fancy aggregations that filter the input - the filter is the last part of the aggregation.
(:sum-where :count-where :share)
[(last aggregation)]
;; Metrics are standard filter + aggregation units; if the column is a metric get its filters.
:metric
(-> (lib.metadata/metric query (last aggregation))
:definition
lib.convert/js-legacy-inner-query->pMBQL
(assoc :database (:database query))
(lib.filter/filters -1))
;; Default: no filters to add.
nil))))) |
(defmethod lib.drill-thru.common/drill-thru-method :drill-thru/underlying-records
[query _stage-number context & _]
;; Note that the input _stage-number is deliberately ignored. The top-level query may have fewer stages than the
;; input query; all operations are performed on the final stage of the top-level query.
(drill-underlying-records (lib.underlying/top-level-query query)
(update context :dimensions
(fn [dims]
(for [dim dims]
(update dim :column #(lib.underlying/top-level-column query %))))))) | |
Object details drill for PK columns when there is a single PK column available. Entry points:
Requirements:
Query transformation:
Question transformation:
A We will only possibly return one of the 'object details' drills ([[metabase.lib.drill-thru.pk]], [[metabase.lib.drill-thru.fk-details]], or [[metabase.lib.drill-thru.zoom]]); see [[metabase.lib.drill-thru.object-details]] for the high-level logic that calls out to the individual implementations. | (ns metabase.lib.drill-thru.zoom (:require [medley.core :as m] [metabase.lib.drill-thru.common :as lib.drill-thru.common] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.drill-thru :as lib.schema.drill-thru] [metabase.lib.types.isa :as lib.types.isa] [metabase.util.malli :as mu])) |
(defn- zoom-drill* [column value]
{:lib/type :metabase.lib.drill-thru/drill-thru
:type :drill-thru/zoom
:column column
:object-id value
:many-pks? false}) | |
(mu/defn zoom-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.zoom]
"Return a `:zoom` drill when clicking on the value of a PK column in a Table that has only one PK column."
[query :- ::lib.schema/query
_stage-number :- :int
{:keys [column value row] :as _context} :- ::lib.schema.drill-thru/context]
(when (and
;; ignore clicks on headers (value = nil rather than :null)
(some? value)
;; if this table has more than one PK we should be returning a [[metabase.lib.drill-thru.pk]] instead.
(not (lib.drill-thru.common/many-pks? query)))
(if (lib.types.isa/primary-key? column)
;; PK column was clicked. Ignore NULL values.
(when-not (= value :null)
(zoom-drill* column value))
;; some other column was clicked. Find the PK column and create a filter for its value.
(let [[pk-column] (lib.metadata.calculation/primary-keys query)]
(when-let [pk-value (->> row
(m/find-first #(-> % :column :name (= (:name pk-column))))
:value)]
(zoom-drill* pk-column pk-value)))))) | |
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/zoom [_query _stage-number drill-thru] (select-keys drill-thru [:many-pks? :object-id :type])) | |
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/zoom :- ::lib.schema/query [query :- ::lib.schema/query _stage-number :- :int _drill :- ::lib.schema.drill-thru/drill-thru.zoom] ;; this is just an identity transformation, see ;; https://metaboat.slack.com/archives/C04CYTEL9N2/p1693965932617369 query) | |
"Zoom" transform for numeric (including location) columns. Entry points:
Requirements:
Query transformation:
Question transformation:
This covers two types of 'zoom in' drills:
| (ns metabase.lib.drill-thru.zoom-in-bins (:require [metabase.lib.binning :as lib.binning] [metabase.lib.breakout :as lib.breakout] [metabase.lib.drill-thru.common :as lib.drill-thru.common] [metabase.lib.filter :as lib.filter] [metabase.lib.remove-replace :as lib.remove-replace] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.binning :as lib.schema.binning] [metabase.lib.schema.drill-thru :as lib.schema.drill-thru] [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.util.malli :as mu])) |
available-drill-thrus | |
(mu/defn zoom-in-binning-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.zoom-in.binning]
"Return a drill thru that 'zooms in' on a breakout that uses `:binning` if applicable.
See [[metabase.lib.drill-thru.zoom-in-bins]] docstring for more information."
[query :- ::lib.schema/query
stage-number :- :int
{:keys [column value], :as _context} :- ::lib.schema.drill-thru/context]
(when (and column value)
(when-let [existing-breakout (first (lib.breakout/existing-breakouts query stage-number column))]
(when-let [binning (lib.binning/binning existing-breakout)]
(when-let [{:keys [min-value max-value bin-width]} (lib.binning/resolve-bin-width query column value)]
(case (:strategy binning)
(:num-bins :default)
{:lib/type :metabase.lib.drill-thru/drill-thru
:type :drill-thru/zoom-in.binning
:column column
:min-value value
:max-value (+ value bin-width)
:new-binning {:strategy :default}}
:bin-width
{:lib/type :metabase.lib.drill-thru/drill-thru
:type :drill-thru/zoom-in.binning
:column column
:min-value min-value
:max-value max-value
:new-binning (update binning :bin-width #(double (/ % 10.0)))})))))) | |
application | |
(mu/defn ^:private update-breakout :- ::lib.schema/query
[query :- ::lib.schema/query
stage-number :- :int
column :- ::lib.schema.metadata/column
new-binning :- ::lib.schema.binning/binning]
(if-let [existing-breakout (first (lib.breakout/existing-breakouts query stage-number column))]
(lib.remove-replace/replace-clause query stage-number existing-breakout (lib.binning/with-binning column new-binning))
(lib.breakout/breakout query stage-number (lib.binning/with-binning column new-binning)))) | |
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/zoom-in.binning :- ::lib.schema/query
[query :- ::lib.schema/query
stage-number :- :int
{:keys [column min-value max-value new-binning]} :- ::lib.schema.drill-thru/drill-thru.zoom-in.binning]
(-> query
(lib.filter/filter stage-number (lib.filter/>= column min-value))
(lib.filter/filter stage-number (lib.filter/< column max-value))
(update-breakout stage-number column new-binning))) | |
"Zoom" transform for different geo semantic types. Entry points:
Possible transformations:
Query transformation follows rules from other
Question transformation:
All geographic zooms require both a These drills are only for 'cell' context for specific values. Geographic zooms are of the following flavors:
| (ns metabase.lib.drill-thru.zoom-in-geographic (:require [medley.core :as m] [metabase.lib.binning :as lib.binning] [metabase.lib.breakout :as lib.breakout] [metabase.lib.drill-thru.common :as lib.drill-thru.common] [metabase.lib.filter :as lib.filter] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.remove-replace :as lib.remove-replace] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.binning :as lib.schema.binning] [metabase.lib.schema.drill-thru :as lib.schema.drill-thru] [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.lib.types.isa :as lib.types.isa] [metabase.lib.util :as lib.util] [metabase.util.malli :as mu])) |
(def ^:private ContextWithLatLon
[:merge
::lib.schema.drill-thru/context
[:map
[:lat-column ::lib.schema.metadata/column]
[:lon-column ::lib.schema.metadata/column]
[:lat-value [:maybe number?]]
[:lon-value [:maybe number?]]]]) | |
(mu/defn ^:private context-with-lat-lon :- [:maybe ContextWithLatLon]
[query :- ::lib.schema/query
stage-number :- :int
{:keys [row], :as context} :- ::lib.schema.drill-thru/context]
(let [stage (lib.util/query-stage query stage-number)
;; First check returned columns in case we breakout by lat/lon so we maintain the binning, othwerwise check visible.
[lat-column lon-column] (some
(fn [columns]
(when-let [lat-column (m/find-first lib.types.isa/latitude? columns)]
(when-let [lon-column (m/find-first lib.types.isa/longitude? columns)]
[lat-column lon-column])))
[(lib.metadata.calculation/returned-columns query stage-number stage)
(lib.metadata.calculation/visible-columns query stage-number stage)])]
(when (and lat-column lon-column)
(letfn [(same-column? [col-x col-y]
(if (:id col-x)
(= (:id col-x) (:id col-y))
(= (:lib/desired-column-alias col-x) (:lib/desired-column-alias col-y))))
(column-value [column]
(some
(fn [row-value]
(when (same-column? column (:column row-value))
(:value row-value)))
row))]
(assoc context
:lat-column lat-column
:lon-column lon-column
:lat-value (column-value lat-column)
:lon-value (column-value lon-column)))))) | |
available-drill-thrus | |
(mu/defn ^:private country-state-city->binned-lat-lon-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.zoom-in.geographic.country-state-city->binned-lat-lon]
[{:keys [column value lat-column lon-column], :as _context} :- ContextWithLatLon
lat-lon-bin-width :- ::lib.schema.binning/bin-width]
(when value
{:lib/type :metabase.lib.drill-thru/drill-thru
:type :drill-thru/zoom-in.geographic
:subtype :drill-thru.zoom-in.geographic/country-state-city->binned-lat-lon
:column column
:value value
:latitude {:column lat-column
:bin-width lat-lon-bin-width}
:longitude {:column lon-column
:bin-width lat-lon-bin-width}})) | |
(mu/defn ^:private country->binned-lat-lon-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.zoom-in.geographic.country-state-city->binned-lat-lon]
[{:keys [column], :as context} :- ContextWithLatLon]
(when (some-> column lib.types.isa/country?)
(country-state-city->binned-lat-lon-drill context 10))) | |
(mu/defn ^:private state->binned-lat-lon-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.zoom-in.geographic.country-state-city->binned-lat-lon]
[{:keys [column], :as context} :- ContextWithLatLon]
(when (some-> column lib.types.isa/state?)
(country-state-city->binned-lat-lon-drill context 1))) | |
(mu/defn ^:private city->binned-lat-lon-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.zoom-in.geographic.country-state-city->binned-lat-lon]
[{:keys [column], :as context} :- ContextWithLatLon]
(when (some-> column lib.types.isa/city?)
(country-state-city->binned-lat-lon-drill context 0.1))) | |
(mu/defn ^:private binned-lat-lon->binned-lat-lon-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.zoom-in.geographic.binned-lat-lon->binned-lat-lon]
[metadata-providerable :- ::lib.schema.metadata/metadata-providerable
{:keys [lat-column lon-column lat-value lon-value], :as _context} :- ContextWithLatLon]
(when (and lat-value
lon-value)
(when-let [{lat-bin-width :bin-width} (lib.binning/resolve-bin-width metadata-providerable lat-column lat-value)]
(when-let [{lon-bin-width :bin-width} (lib.binning/resolve-bin-width metadata-providerable lon-column lon-value)]
(let [[new-lat-bin-width new-lon-bin-width] (if (and (>= lat-bin-width 20)
(>= lon-bin-width 20))
[10 10]
[(/ lat-bin-width 10.0)
(/ lon-bin-width 10.0)])]
{:lib/type :metabase.lib.drill-thru/drill-thru
:type :drill-thru/zoom-in.geographic
:subtype :drill-thru.zoom-in.geographic/binned-lat-lon->binned-lat-lon
:latitude {:column lat-column
:bin-width new-lat-bin-width
:min lat-value
:max (+ lat-value lat-bin-width)}
:longitude {:column lon-column
:bin-width new-lon-bin-width
:min lon-value
:max (+ lon-value lon-bin-width)}}))))) | |
(mu/defn zoom-in-geographic-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.zoom-in.geographic]
"Return a `:drill-thru/zoom-in.geographic` drill if appropriate. See docstring
for [[metabase.lib.drill-thru.zoom-in-geographic]] for more information on what circumstances this is returned in
and what it means to apply this drill."
[query :- ::lib.schema/query
stage-number :- :int
{:keys [value], :as context} :- ::lib.schema.drill-thru/context]
(when value
(when-let [context (context-with-lat-lon query stage-number context)]
(some (fn [f]
(f context))
[country->binned-lat-lon-drill
state->binned-lat-lon-drill
city->binned-lat-lon-drill
(partial binned-lat-lon->binned-lat-lon-drill query)])))) | |
Application | |
(mu/defn ^:private add-or-update-binning :- ::lib.schema/query
[query :- ::lib.schema/query
stage-number :- :int
column :- ::lib.schema.metadata/column
bin-width :- pos?]
(let [binning {:strategy :bin-width
:bin-width bin-width}]
(if-let [existing-breakout (first (lib.breakout/existing-breakouts query stage-number column))]
(let [new-breakout (lib.binning/with-binning existing-breakout binning)]
(lib.remove-replace/replace-clause query stage-number existing-breakout new-breakout))
(lib.breakout/breakout query stage-number (lib.binning/with-binning column binning))))) | |
(mu/defn ^:private add-or-update-lat-lon-binning :- ::lib.schema/query
[query :- ::lib.schema/query
stage-number :- :int
{{lat :column, lat-bin-width :bin-width} :latitude
{lon :column, lon-bin-width :bin-width} :longitude} :- ::lib.schema.drill-thru/drill-thru.zoom-in.geographic]
(-> query
(add-or-update-binning stage-number lat lat-bin-width)
(add-or-update-binning stage-number lon lon-bin-width))) | |
(mu/defn ^:private apply-country-state-city->binned-lat-lon-drill :- ::lib.schema/query
[query :- ::lib.schema/query
stage-number :- :int
{:keys [column value], :as drill} :- ::lib.schema.drill-thru/drill-thru.zoom-in.geographic.country-state-city->binned-lat-lon]
(-> query
(lib.breakout/remove-existing-breakouts-for-column stage-number column)
;; TODO -- remove/update existing filter?
(lib.filter/filter stage-number (lib.filter/= column value))
(add-or-update-lat-lon-binning stage-number drill))) | |
(mu/defn ^:private apply-binned-lat-lon->binned-lat-lon-drill :- ::lib.schema/query
[query :- ::lib.schema/query
stage-number :- :int
{{lat :column, lat-min :min, lat-max :max} :latitude
{lon :column, lon-min :min, lon-max :max} :longitude
:as drill} :- ::lib.schema.drill-thru/drill-thru.zoom-in.geographic.binned-lat-lon->binned-lat-lon]
(-> query
;; TODO -- remove/update existing filters on these columns?
(lib.filter/filter stage-number (lib.filter/>= lat lat-min))
(lib.filter/filter stage-number (lib.filter/< lat lat-max))
(lib.filter/filter stage-number (lib.filter/>= lon lon-min))
(lib.filter/filter stage-number (lib.filter/< lon lon-max))
(add-or-update-lat-lon-binning stage-number drill))) | |
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/zoom-in.geographic :- ::lib.schema/query
[query :- ::lib.schema/query
stage-number :- :int
{:keys [subtype], :as drill} :- ::lib.schema.drill-thru/drill-thru.zoom-in.geographic]
(case subtype
:drill-thru.zoom-in.geographic/country-state-city->binned-lat-lon
(apply-country-state-city->binned-lat-lon-drill query stage-number drill)
:drill-thru.zoom-in.geographic/binned-lat-lon->binned-lat-lon
(apply-binned-lat-lon->binned-lat-lon-drill query stage-number drill))) | |
"See this month by weeks" type of transform. Entry points:
Requirements:
Query transformation:
Question transformation:
| (ns metabase.lib.drill-thru.zoom-in-timeseries
(:require
[metabase.lib.breakout :as lib.breakout]
[metabase.lib.drill-thru.common :as lib.drill-thru.common]
[metabase.lib.equality :as lib.equality]
[metabase.lib.filter :as lib.filter]
[metabase.lib.metadata :as lib.metadata]
[metabase.lib.remove-replace :as lib.remove-replace]
[metabase.lib.schema :as lib.schema]
[metabase.lib.schema.common :as lib.schema.common]
[metabase.lib.schema.drill-thru :as lib.schema.drill-thru]
[metabase.lib.schema.temporal-bucketing
:as lib.schema.temporal-bucketing]
[metabase.lib.temporal-bucket :as lib.temporal-bucket]
[metabase.lib.util :as lib.util]
[metabase.shared.util.i18n :as i18n]
[metabase.util.malli :as mu])) |
TODO -- we shouldn't include hour and minute for | (def ^:private valid-current-units [:year :quarter :month :week :day :hour :minute]) |
(def ^:private unit->next-unit
(zipmap (drop-last valid-current-units)
(drop 1 valid-current-units))) | |
(mu/defn ^:private matching-breakout-dimension :- [:maybe ::lib.schema.drill-thru/context.row.value]
[query :- ::lib.schema/query
stage-number :- :int
dimensions :- [:sequential ::lib.schema.drill-thru/context.row.value]]
(first (for [breakout (lib.breakout/breakouts query stage-number)
:when (and (lib.util/clause-of-type? breakout :field)
(lib.temporal-bucket/temporal-bucket breakout))
{:keys [column] :as dimension} dimensions
:when (and (lib.equality/find-matching-column breakout [column])
(= (lib.temporal-bucket/temporal-bucket breakout)
(lib.temporal-bucket/temporal-bucket column)))]
(assoc dimension :column-ref breakout)))) | |
(mu/defn ^:private next-breakout-unit :- [:maybe ::lib.schema.temporal-bucketing/unit.date-time.truncate]
[column :- lib.metadata/ColumnMetadata]
(when-let [current-unit (lib.temporal-bucket/raw-temporal-bucket column)]
(when (contains? (set valid-current-units) current-unit)
(unit->next-unit current-unit)))) | |
(mu/defn ^:private describe-next-unit :- ::lib.schema.common/non-blank-string
[unit :- ::lib.schema.drill-thru/drill-thru.zoom-in.timeseries.next-unit]
(case unit
:quarter (i18n/tru "See this year by quarter")
:month (i18n/tru "See this quarter by month")
:week (i18n/tru "See this month by week")
:day (i18n/tru "See this week by day")
:hour (i18n/tru "See this day by hour")
:minute (i18n/tru "See this hour by minute"))) | |
(mu/defn zoom-in-timeseries-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.zoom-in.timeseries]
"Zooms in on some window, showing it in finer detail.
For example: The month of a year, days or weeks of a quarter, smaller lat/long regions, etc.
This is different from the `:drill-thru/zoom` type, which is for showing the details of a single object."
[query :- ::lib.schema/query
stage-number :- :int
{:keys [dimensions], :as _context} :- ::lib.schema.drill-thru/context]
(when (and (lib.drill-thru.common/mbql-stage? query stage-number)
(not-empty dimensions))
(when-let [{:keys [value], :as dimension} (matching-breakout-dimension query stage-number dimensions)]
(when value
(when-let [next-unit (next-breakout-unit (:column dimension))]
{:lib/type :metabase.lib.drill-thru/drill-thru
:display-name (describe-next-unit next-unit)
:type :drill-thru/zoom-in.timeseries
:dimension dimension
:next-unit next-unit}))))) | |
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/zoom-in.timeseries
[query :- ::lib.schema/query
stage-number :- :int
{:keys [dimension next-unit]} :- ::lib.schema.drill-thru/drill-thru.zoom-in.timeseries]
(let [{:keys [column value]} dimension
old-breakout (:column-ref dimension)
new-breakout (lib.temporal-bucket/with-temporal-bucket old-breakout next-unit)]
(-> query
(lib.filter/filter stage-number (lib.filter/= column value))
(lib.remove-replace/replace-clause stage-number old-breakout new-breakout)))) | |
(ns metabase.lib.expression
(:refer-clojure
:exclude
[+ - * / case coalesce abs time concat replace])
(:require
[clojure.string :as str]
[malli.core :as mc]
[medley.core :as m]
[metabase.lib.common :as lib.common]
[metabase.lib.hierarchy :as lib.hierarchy]
[metabase.lib.metadata :as lib.metadata]
[metabase.lib.metadata.calculation :as lib.metadata.calculation]
[metabase.lib.options :as lib.options]
[metabase.lib.ref :as lib.ref]
[metabase.lib.schema :as lib.schema]
[metabase.lib.schema.common :as lib.schema.common]
[metabase.lib.schema.expression :as lib.schema.expression]
[metabase.lib.schema.temporal-bucketing
:as lib.schema.temporal-bucketing]
[metabase.lib.temporal-bucket :as lib.temporal-bucket]
[metabase.lib.util :as lib.util]
[metabase.shared.util.i18n :as i18n]
[metabase.types :as types]
[metabase.util :as u]
[metabase.util.malli :as mu])) | |
(mu/defn column-metadata->expression-ref :- :mbql.clause/expression
"Given `:metadata/column` column metadata for an expression, construct an `:expression` reference."
[metadata :- lib.metadata/ColumnMetadata]
(let [options {:lib/uuid (str (random-uuid))
:base-type (:base-type metadata)
:effective-type ((some-fn :effective-type :base-type) metadata)}]
[:expression options ((some-fn :lib/expression-name :name) metadata)])) | |
(mu/defn resolve-expression :- ::lib.schema.expression/expression
"Find the expression with `expression-name` in a given stage of a `query`, or throw an Exception if it doesn't
exist."
([query expression-name]
(resolve-expression query -1 expression-name))
([query :- ::lib.schema/query
stage-number :- :int
expression-name :- ::lib.schema.common/non-blank-string]
(let [stage (lib.util/query-stage query stage-number)]
(or (m/find-first (comp #{expression-name} lib.util/expression-name)
(:expressions stage))
(throw (ex-info (i18n/tru "No expression named {0}" (pr-str expression-name))
{:expression-name expression-name
:query query
:stage-number stage-number})))))) | |
(defmethod lib.metadata.calculation/type-of-method :expression
[query stage-number [_expression _opts expression-name, :as _expression-ref]]
(let [expression (resolve-expression query stage-number expression-name)]
(lib.metadata.calculation/type-of query stage-number expression))) | |
(defmethod lib.metadata.calculation/metadata-method :expression
[query stage-number [_expression opts expression-name, :as expression-ref-clause]]
{:lib/type :metadata/column
:lib/source-uuid (:lib/uuid opts)
:name expression-name
:lib/expression-name expression-name
:display-name (lib.metadata.calculation/display-name query stage-number expression-ref-clause)
:base-type (lib.metadata.calculation/type-of query stage-number expression-ref-clause)
:lib/source :source/expressions}) | |
(defmethod lib.metadata.calculation/display-name-method :dispatch-type/integer [_query _stage-number n _style] (str n)) | |
(defmethod lib.metadata.calculation/display-name-method :dispatch-type/number [_query _stage-number n _style] (str n)) | |
(defmethod lib.metadata.calculation/display-name-method :dispatch-type/string [_query _stage-number s _style] (str \" s \")) | |
(defmethod lib.metadata.calculation/display-name-method :dispatch-type/boolean [_query _stage-number s _style] (str s)) | |
(defmethod lib.metadata.calculation/display-name-method :expression [_query _stage-number [_expression _opts expression-name] _style] expression-name) | |
(defmethod lib.metadata.calculation/column-name-method :expression [_query _stage-number [_expression _opts expression-name]] expression-name) | |
Whether the display name we are generated is recursively nested inside another display name. For infix math operators we'll wrap the results in parentheses to make the display name more obvious. | (def ^:private ^:dynamic *nested* false) |
(defn- wrap-str-in-parens-if-nested [s]
(if *nested*
(str \( s \))
s)) | |
Generate a infix-style display name for an arithmetic expression like | (defn- infix-display-name
[query stage-number operator args]
(wrap-str-in-parens-if-nested
(binding [*nested* true]
(str/join (str \space (name operator) \space)
(map (partial lib.metadata.calculation/display-name query stage-number)
args))))) |
(def ^:private infix-operator-display-name
{:+ "+"
:- "-"
:* "×"
:/ "÷"}) | |
(doseq [tag [:+ :- :/ :*]] (lib.hierarchy/derive tag ::infix-operator)) | |
(defmethod lib.metadata.calculation/display-name-method ::infix-operator [query stage-number [tag _opts & args] _style] (infix-display-name query stage-number (get infix-operator-display-name tag) args)) | |
(defmethod lib.metadata.calculation/column-name-method ::infix-operator [_query _stage-number _expr] "expression") | |
| (defmethod lib.metadata.calculation/type-of-method :lib.type-of/type-is-type-of-arithmetic-args
[query stage-number [_tag _opts & args]]
;; Okay to use reduce without an init value here since we know we have >= 2 args
#_{:clj-kondo/ignore [:reduce-without-init]}
(reduce
types/most-specific-common-ancestor
(for [arg args]
(lib.metadata.calculation/type-of query stage-number arg)))) |
TODO -- this stuff should probably be moved into [[metabase.lib.temporal-bucket]] | |
(defn- interval-unit-str [amount unit]
;; this uses [[clojure.string/lower-case]] so its in the user's locale in the browser rather than always using
;; English lower-casing rules.
#_{:clj-kondo/ignore [:discouraged-var]}
(str/lower-case (lib.temporal-bucket/describe-temporal-unit amount unit))) | |
(mu/defn ^:private interval-display-name :- ::lib.schema.common/non-blank-string
"e.g. something like \"- 2 days\
[amount :- :int
unit :- ::lib.schema.temporal-bucketing/unit.date-time.interval]
;; TODO -- sorta duplicated with [[metabase.shared.parameters.parameters/translated-interval]], but not exactly
(let [unit-str (interval-unit-str amount unit)]
(wrap-str-in-parens-if-nested
(if (pos? amount)
(lib.util/format "+ %d %s" amount unit-str)
(lib.util/format "- %d %s" (clojure.core/abs amount) unit-str))))) | |
(mu/defn ^:private interval-column-name :- ::lib.schema.common/non-blank-string
"e.g. something like `minus_2_days`"
[amount :- :int
unit :- ::lib.schema.temporal-bucketing/unit.date-time.interval]
;; TODO -- sorta duplicated with [[metabase.shared.parameters.parameters/translated-interval]], but not exactly
(let [unit-str (interval-unit-str amount unit)]
(if (pos? amount)
(lib.util/format "plus_%s_%s" amount unit-str)
(lib.util/format "minus_%d_%s" (clojure.core/abs amount) unit-str)))) | |
(defmethod lib.metadata.calculation/display-name-method :datetime-add
[query stage-number [_datetime-add _opts x amount unit] style]
(str (lib.metadata.calculation/display-name query stage-number x style)
\space
(interval-display-name amount unit))) | |
(defmethod lib.metadata.calculation/column-name-method :datetime-add
[query stage-number [_datetime-add _opts x amount unit]]
(str (lib.metadata.calculation/column-name query stage-number x)
\_
(interval-column-name amount unit))) | |
for now we'll just pretend | (defmethod lib.metadata.calculation/display-name-method :coalesce [query stage-number [_coalesce _opts expr _null-expr] style] (lib.metadata.calculation/display-name query stage-number expr style)) |
(defmethod lib.metadata.calculation/column-name-method :coalesce [query stage-number [_coalesce _opts expr _null-expr]] (lib.metadata.calculation/column-name query stage-number expr)) | |
(defn- conflicting-name? [query stage-number expression-name]
(let [stage (lib.util/query-stage query stage-number)
cols (lib.metadata.calculation/visible-columns query stage-number stage)
expr-name (u/lower-case-en expression-name)]
(some #(-> % :name u/lower-case-en (= expr-name)) cols))) | |
(defn- add-expression-to-stage
[stage expression]
(cond-> (update stage :expressions (fnil conj []) expression)
;; if there are explicit fields selected, add the expression to them
(vector? (:fields stage))
(update :fields conj (lib.options/ensure-uuid [:expression {} (lib.util/expression-name expression)])))) | |
(mu/defn expression :- ::lib.schema/query
"Adds an expression to query."
([query expression-name expressionable]
(expression query -1 expression-name expressionable))
([query :- ::lib.schema/query
stage-number :- [:maybe :int]
expression-name :- ::lib.schema.common/non-blank-string
expressionable]
(let [stage-number (or stage-number -1)]
(when (conflicting-name? query stage-number expression-name)
(throw (ex-info "Expression name conflicts with a column in the same query stage"
{:expression-name expression-name})))
(lib.util/update-query-stage
query stage-number
add-expression-to-stage
(-> (lib.common/->op-arg expressionable)
(lib.util/top-level-expression-clause expression-name)))))) | |
(lib.common/defop + [x y & more]) (lib.common/defop - [x y & more]) (lib.common/defop * [x y & more]) | |
Kondo gets confused | #_{:clj-kondo/ignore [:unresolved-namespace]}
(lib.common/defop / [x y & more])
(lib.common/defop case [x y & more])
(lib.common/defop coalesce [x y & more])
(lib.common/defop abs [x])
(lib.common/defop log [x])
(lib.common/defop exp [x])
(lib.common/defop sqrt [x])
(lib.common/defop ceil [x])
(lib.common/defop floor [x])
(lib.common/defop round [x])
(lib.common/defop power [n expo])
(lib.common/defop interval [n unit])
(lib.common/defop relative-datetime [t unit])
(lib.common/defop time [t unit])
(lib.common/defop absolute-datetime [t unit])
(lib.common/defop now [])
(lib.common/defop convert-timezone [t source dest])
(lib.common/defop get-week [t mode])
(lib.common/defop get-year [t])
(lib.common/defop get-month [t])
(lib.common/defop get-day [t])
(lib.common/defop get-hour [t])
(lib.common/defop get-minute [t])
(lib.common/defop get-second [t])
(lib.common/defop get-quarter [t])
(lib.common/defop datetime-add [t i unit])
(lib.common/defop datetime-subtract [t i unit])
(lib.common/defop concat [s1 s2 & more])
(lib.common/defop substring [s start end])
(lib.common/defop replace [s search replacement])
(lib.common/defop regexextract [s regex])
(lib.common/defop length [s])
(lib.common/defop trim [s])
(lib.common/defop ltrim [s])
(lib.common/defop rtrim [s])
(lib.common/defop upper [s])
(lib.common/defop lower [s]) |
(mu/defn ^:private expression-metadata :- lib.metadata/ColumnMetadata
[query :- ::lib.schema/query
stage-number :- :int
expression-definition :- ::lib.schema.expression/expression]
(let [expression-name (lib.util/expression-name expression-definition)]
(-> (lib.metadata.calculation/metadata query stage-number expression-definition)
(assoc :lib/source :source/expressions
:name expression-name
:display-name expression-name)))) | |
(mu/defn expressions-metadata :- [:maybe [:sequential lib.metadata/ColumnMetadata]]
"Get metadata about the expressions in a given stage of a `query`."
([query]
(expressions-metadata query -1))
([query :- ::lib.schema/query
stage-number :- :int]
(some->> (not-empty (:expressions (lib.util/query-stage query stage-number)))
(mapv (partial expression-metadata query stage-number))))) | |
(mu/defn expressions :- [:maybe ::lib.schema.expression/expressions]
"Get the expressions map from a given stage of a `query`."
([query]
(expressions query -1))
([query :- ::lib.schema/query
stage-number :- :int]
(not-empty (:expressions (lib.util/query-stage query stage-number))))) | |
(defmethod lib.ref/ref-method :expression [expression-clause] expression-clause) | |
(mu/defn expressionable-columns :- [:sequential lib.metadata/ColumnMetadata]
"Get column metadata for all the columns that can be used expressions in
the stage number `stage-number` of the query `query` and in expression index `expression-position`
If `stage-number` is omitted, the last stage is used.
Pass nil to `expression-position` for new expressions.
The rules for determining which columns can be broken out by are as follows:
1. custom `:expressions` in this stage of the query, that come before the `expression-position`
2. Fields 'exported' by the previous stage of the query, if there is one;
otherwise Fields from the current `:source-table`
3. Fields exported by explicit joins
4. Fields in Tables that are implicitly joinable."
([query :- ::lib.schema/query
expression-position :- [:maybe ::lib.schema.common/int-greater-than-or-equal-to-zero]]
(expressionable-columns query -1 expression-position))
([query :- ::lib.schema/query
stage-number :- :int
expression-position :- [:maybe ::lib.schema.common/int-greater-than-or-equal-to-zero]]
(let [indexed-expressions (into {} (map-indexed (fn [idx expr]
[(lib.util/expression-name expr) idx])
(expressions query stage-number)))
unavailable-expressions (fn [column]
(or (not expression-position)
(not= (:lib/source column) :source/expressions)
(< (get indexed-expressions (:name column)) expression-position)))
stage (lib.util/query-stage query stage-number)
columns (lib.metadata.calculation/visible-columns query stage-number stage)]
(->> columns
(filterv unavailable-expressions)
not-empty)))) | |
(mu/defn expression-ref :- :mbql.clause/expression
"Find the expression with `expression-name` using [[resolve-expression]], then create a ref for it. Intended for use
when creating queries using threading macros e.g.
(-> (lib/query ...)
(lib/expression \"My Expression\" ...)
(as-> <> (lib/aggregate <> (lib/avg (lib/expression-ref <> \"My Expression\")))))"
([query expression-name]
(expression-ref query -1 expression-name))
([query :- ::lib.schema/query
stage-number :- :int
expression-name :- ::lib.schema.common/non-blank-string]
(->> expression-name
(resolve-expression query stage-number)
(expression-metadata query stage-number)
lib.ref/ref))) | |
(def ^:private expression-validator (mc/validator ::lib.schema.expression/expression)) | |
Returns true if | (defn expression-clause? [expression-clause] (expression-validator expression-clause)) |
(mu/defn with-expression-name :- ::lib.schema.expression/expression
"Return a new expression clause like `an-expression-clause` but with name `new-name`.
For expressions from the :expressions clause of a pMBQL query this sets the :lib/expression-name option,
for other expressions (for example named aggregation expressions) the :display-name option is set.
Note that always setting :lib/expression-name would lead to confusion, because that option is used
to decide what kind of reference is to be created. For example, expression are referenced by name,
aggregations are referenced by position."
[an-expression-clause :- ::lib.schema.expression/expression
new-name :- :string]
(lib.options/update-options
(if (lib.util/clause? an-expression-clause)
an-expression-clause
[:value {:effective-type (lib.schema.expression/type-of an-expression-clause)}
an-expression-clause])
(fn [opts]
(let [opts (assoc opts :lib/uuid (str (random-uuid)))]
(if (:lib/expression-name opts)
(-> opts
(dissoc :display-name :name)
(assoc :lib/expression-name new-name))
(assoc opts :name new-name :display-name new-name)))))) | |
(ns metabase.lib.fe-util (:require [metabase.lib.common :as lib.common] [metabase.lib.field :as lib.field] [metabase.lib.filter :as lib.filter] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.options :as lib.options] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.expression :as lib.schema.expression] [metabase.lib.schema.temporal-bucketing :as lib.schema.temporal-bucketing] [metabase.lib.temporal-bucket :as lib.temporal-bucket] [metabase.lib.util :as lib.util] [metabase.mbql.util :as mbql.u] [metabase.shared.util.i18n :as i18n] [metabase.shared.util.time :as shared.ut] [metabase.util :as u] [metabase.util.malli :as mu])) | |
(def ^:private ExpressionParts [:map [:lib/type [:= :mbql/expression-parts]] [:operator [:or :keyword :string]] [:options ::lib.schema.common/options] [:args [:sequential :any]]]) | |
(mu/defn expression-parts :- ExpressionParts
"Return the parts of the filter clause `expression-clause` in query `query` at stage `stage-number`."
([query expression-clause]
(expression-parts query -1 expression-clause))
([query :- ::lib.schema/query
stage-number :- :int
expression-clause :- ::lib.schema.expression/expression]
(let [[op options & args] expression-clause
->maybe-col #(when (lib.util/ref-clause? %)
(lib.filter/add-column-operators
(lib.field/extend-column-metadata-from-ref
query stage-number
(lib.metadata.calculation/metadata query stage-number %)
%)))]
{:lib/type :mbql/expression-parts
:operator op
:options options
:args (mapv (fn [arg]
(if (lib.util/clause? arg)
(if-let [col (->maybe-col arg)]
col
(expression-parts query stage-number arg))
arg))
args)}))) | |
(defmethod lib.common/->op-arg :mbql/expression-parts
[{:keys [operator options args] :or {options {}}}]
(lib.common/->op-arg (lib.options/ensure-uuid (into [(keyword operator) options]
(map lib.common/->op-arg)
args)))) | |
(mu/defn expression-clause :- ::lib.schema.expression/expression "Returns a standalone clause for an `operator`, `options`, and arguments." [operator :- :keyword args :- [:sequential :any] options :- [:maybe :map]] (lib.options/ensure-uuid (into [operator options] (map lib.common/->op-arg) args))) | |
(mu/defn filter-args-display-name :- :string
"Provides a reasonable display name for the `filter-clause` excluding the column-name.
Can be expanded as needed but only currently defined for a narrow set of date filters.
Falls back to the full filter display-name"
[query stage-number filter-clause]
(let [->temporal-name #(shared.ut/format-unit % nil)
temporal? #(lib.util/original-isa? % :type/Temporal)
unit-is (fn [unit-or-units]
(let [units (set (u/one-or-many unit-or-units))]
(fn [maybe-clause]
(clojure.core/and
(temporal? maybe-clause)
(lib.util/clause? maybe-clause)
(clojure.core/contains? units (:temporal-unit (second maybe-clause)))))))]
(mbql.u/match-one filter-clause
[:= _ (x :guard (unit-is lib.schema.temporal-bucketing/datetime-truncation-units)) (y :guard string?)]
(shared.ut/format-relative-date-range y 0 (:temporal-unit (second x)) nil nil {:include-current true})
[:= _ (x :guard temporal?) (y :guard (some-fn int? string?))]
(lib.temporal-bucket/describe-temporal-pair x y)
[:!= _ (x :guard temporal?) (y :guard (some-fn int? string?))]
(i18n/tru "Excludes {0}" (lib.temporal-bucket/describe-temporal-pair x y))
[:< _ (x :guard temporal?) (y :guard string?)]
(i18n/tru "Before {0}" (->temporal-name y))
[:> _ (x :guard temporal?) (y :guard string?)]
(i18n/tru "After {0}" (->temporal-name y))
[:between _ (x :guard temporal?) (y :guard string?) (z :guard string?)]
(shared.ut/format-diff y z)
[:is-null & _]
(i18n/tru "Is Empty")
[:not-null & _]
(i18n/tru "Is Not Empty")
[:time-interval _ (x :guard temporal?) n unit]
(lib.temporal-bucket/describe-temporal-interval n unit)
_
(lib.metadata.calculation/display-name query stage-number filter-clause)))) | |
(ns metabase.lib.field
(:require
[clojure.string :as str]
[medley.core :as m]
[metabase.lib.aggregation :as lib.aggregation]
[metabase.lib.binning :as lib.binning]
[metabase.lib.card :as lib.card]
[metabase.lib.dispatch :as lib.dispatch]
[metabase.lib.equality :as lib.equality]
[metabase.lib.expression :as lib.expression]
[metabase.lib.join :as lib.join]
[metabase.lib.join.util :as lib.join.util]
[metabase.lib.metadata :as lib.metadata]
[metabase.lib.metadata.calculation :as lib.metadata.calculation]
[metabase.lib.normalize :as lib.normalize]
[metabase.lib.options :as lib.options]
[metabase.lib.ref :as lib.ref]
[metabase.lib.remove-replace :as lib.remove-replace]
[metabase.lib.schema :as lib.schema]
[metabase.lib.schema.common :as lib.schema.common]
[metabase.lib.schema.id :as lib.schema.id]
[metabase.lib.schema.metadata :as lib.schema.metadata]
[metabase.lib.schema.temporal-bucketing
:as lib.schema.temporal-bucketing]
[metabase.lib.temporal-bucket :as lib.temporal-bucket]
[metabase.lib.types.isa :as lib.types.isa]
[metabase.lib.util :as lib.util]
[metabase.shared.util.i18n :as i18n]
[metabase.shared.util.time :as shared.ut]
[metabase.util :as u]
[metabase.util.humanization :as u.humanization]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.malli.registry :as mr])) | |
(defn- normalize-binning-options [opts]
(lib.normalize/normalize-map
opts
keyword
{:strategy keyword})) | |
(defn- normalize-field-options [opts]
(lib.normalize/normalize-map
opts
keyword
{:temporal-unit keyword
:binning normalize-binning-options})) | |
(defmethod lib.normalize/normalize :field [[tag opts id-or-name]] [(keyword tag) (normalize-field-options opts) id-or-name]) | |
(mu/defn resolve-column-name-in-metadata :- [:maybe ::lib.schema.metadata/column]
"Find the column with `column-name` in a sequence of `column-metadatas`."
[column-name :- ::lib.schema.common/non-blank-string
column-metadatas :- [:sequential ::lib.schema.metadata/column]]
(or (some (fn [k]
(m/find-first #(= (get % k) column-name)
column-metadatas))
[:lib/desired-column-alias :name])
(do
(log/warn (i18n/tru "Invalid :field clause: column {0} does not exist. Found: {1}"
(pr-str column-name)
(pr-str (mapv :lib/desired-column-alias column-metadatas))))
nil))) | |
Whether we're in a recursive call to [[resolve-column-name]] or not. Prevent infinite recursion (#32063) | (def ^:private ^:dynamic *recursive-column-resolution-by-name* false) |
(mu/defn ^:private resolve-column-name :- [:maybe ::lib.schema.metadata/column]
"String column name: get metadata from the previous stage, if it exists, otherwise if this is the first stage and we
have a native query or a Saved Question source query or whatever get it from our results metadata."
[query :- ::lib.schema/query
stage-number :- :int
column-name :- ::lib.schema.common/non-blank-string]
(when-not *recursive-column-resolution-by-name*
(binding [*recursive-column-resolution-by-name* true]
(let [previous-stage-number (lib.util/previous-stage-number query stage-number)
stage (if previous-stage-number
(lib.util/query-stage query previous-stage-number)
(lib.util/query-stage query stage-number))
;; TODO -- it seems a little icky that the existence of `:metabase.lib.stage/cached-metadata` is leaking
;; here, we should look in to fixing this if we can.
stage-columns (or (:metabase.lib.stage/cached-metadata stage)
(get-in stage [:lib/stage-metadata :columns])
(when (or (:source-card stage)
(:source-table stage)
(:expressions stage)
(:fields stage))
(lib.metadata.calculation/visible-columns query stage-number stage))
(log/warn (i18n/tru "Cannot resolve column {0}: stage has no metadata"
(pr-str column-name))))]
(when-let [column (and (seq stage-columns)
(resolve-column-name-in-metadata column-name stage-columns))]
(cond-> column
previous-stage-number (-> (dissoc :id :table-id
::binning ::temporal-unit)
(lib.join/with-join-alias nil)
(assoc :name (or (:lib/desired-column-alias column) (:name column)))
(assoc :lib/source :source/previous-stage)))))))) | |
(mu/defn ^:private resolve-field-metadata :- ::lib.schema.metadata/column
"Resolve metadata for a `:field` ref. This is part of the implementation
for [[lib.metadata.calculation/metadata-method]] a `:field` clause."
[query :- ::lib.schema/query
stage-number :- :int
[_field {:keys [join-alias], :as opts} id-or-name, :as _field-clause] :- :mbql.clause/field]
(let [metadata (merge
(when-let [base-type (:base-type opts)]
{:base-type base-type})
(when-let [effective-type ((some-fn :effective-type :base-type) opts)]
{:effective-type effective-type})
;; TODO -- some of the other stuff in `opts` probably ought to be merged in here as well. Also, if
;; the Field is temporally bucketed, the base-type/effective-type would probably be affected, right?
;; We should probably be taking that into consideration?
(when-let [binning (:binning opts)]
{::binning binning})
(when-let [unit (:temporal-unit opts)]
{::temporal-unit unit})
(cond
(integer? id-or-name) (or (lib.equality/resolve-field-id query stage-number id-or-name)
{:lib/type :metadata/column, :name (str id-or-name)})
join-alias {:lib/type :metadata/column, :name (str id-or-name)}
:else (or (resolve-column-name query stage-number id-or-name)
{:lib/type :metadata/column, :name (str id-or-name)})))]
(cond-> metadata
join-alias (lib.join/with-join-alias join-alias)))) | |
If this is a nested column, add metadata about the parent column. | (mu/defn ^:private add-parent-column-metadata
[query :- ::lib.schema/query
metadata :- ::lib.schema.metadata/column]
(let [parent-metadata (lib.metadata/field query (:parent-id metadata))
{parent-name :name} (cond->> parent-metadata
(:parent-id parent-metadata) (add-parent-column-metadata query))]
(update metadata :name (fn [field-name]
(str parent-name \. field-name))))) |
Effective type of a column when taking the | (defn- column-metadata-effective-type
[{::keys [temporal-unit], :as column-metadata}]
(if (and temporal-unit
(contains? lib.schema.temporal-bucketing/datetime-extraction-units temporal-unit))
:type/Integer
((some-fn :effective-type :base-type) column-metadata))) |
(defmethod lib.metadata.calculation/type-of-method :metadata/column [_query _stage-number column-metadata] (column-metadata-effective-type column-metadata)) | |
(defmethod lib.metadata.calculation/type-of-method :field
[query stage-number [_tag {:keys [temporal-unit], :as _opts} _id-or-name :as field-ref]]
(let [metadata (cond-> (resolve-field-metadata query stage-number field-ref)
temporal-unit (assoc ::temporal-unit temporal-unit))]
(lib.metadata.calculation/type-of query stage-number metadata))) | |
(defmethod lib.metadata.calculation/metadata-method :metadata/column
[_query _stage-number {field-name :name, :as field-metadata}]
(assoc field-metadata :name field-name)) | |
Extend column metadata | (defn extend-column-metadata-from-ref
[query
stage-number
metadata
[_tag {source-uuid :lib/uuid :keys [base-type binning effective-type join-alias source-field temporal-unit], :as opts} :as field-ref]]
(let [metadata (merge
{:lib/type :metadata/column
:lib/source-uuid source-uuid}
metadata
{:display-name (or (:display-name opts)
(lib.metadata.calculation/display-name query stage-number field-ref))})]
(cond-> metadata
effective-type (assoc :effective-type effective-type)
base-type (assoc :base-type base-type)
temporal-unit (assoc ::temporal-unit temporal-unit)
binning (assoc ::binning binning)
source-field (assoc :fk-field-id source-field)
join-alias (lib.join/with-join-alias join-alias)))) |
TODO -- effective type should be affected by | (defmethod lib.metadata.calculation/metadata-method :field
[query stage-number field-ref]
(let [field-metadata (resolve-field-metadata query stage-number field-ref)
metadata (extend-column-metadata-from-ref query stage-number field-metadata field-ref)]
(cond->> metadata
(:parent-id metadata) (add-parent-column-metadata query)))) |
this lives here as opposed to [[metabase.lib.metadata]] because that namespace is more of an interface namespace and moving this there would cause circular references. | (defmethod lib.metadata.calculation/display-name-method :metadata/column
[query stage-number {field-display-name :display-name
field-name :name
temporal-unit :unit
binning ::binning
join-alias :source-alias
fk-field-id :fk-field-id
table-id :table-id
:as field-metadata} style]
(let [field-display-name (or field-display-name
(if (string? field-name)
(u.humanization/name->human-readable-name :simple field-name)
(str field-name)))
join-display-name (when (and (= style :long)
;; don't prepend a join display name if `:display-name` already contains one!
;; Legacy result metadata might include it for joined Fields, don't want to add
;; it twice. Otherwise we'll end up with display names like
;;
;; Products → Products → Category
(not (str/includes? field-display-name " → ")))
(or
(when fk-field-id
;; Implicitly joined column pickers don't use the target table's name, they use the FK field's name with
;; "ID" dropped instead.
;; This is very intentional: one table might have several FKs to one foreign table, each with different
;; meaning (eg. ORDERS.customer_id vs. ORDERS.supplier_id both linking to a PEOPLE table).
;; See #30109 for more details.
(if-let [field (lib.metadata/field query fk-field-id)]
(-> (lib.metadata.calculation/display-info query stage-number field)
:display-name
lib.util/strip-id)
(let [table (lib.metadata/table-or-card query table-id)]
(lib.metadata.calculation/display-name query stage-number table style))))
(or join-alias (lib.join.util/current-join-alias field-metadata))))
display-name (if join-display-name
(str join-display-name " → " field-display-name)
field-display-name)]
(cond
temporal-unit (lib.util/format "%s: %s" display-name (-> (name temporal-unit)
(str/replace \- \space)
u/capitalize-en))
binning (lib.util/format "%s: %s" display-name (lib.binning/binning-display-name binning field-metadata))
:else display-name))) |
(defmethod lib.metadata.calculation/display-name-method :field
[query
stage-number
[_tag {:keys [binning join-alias temporal-unit source-field], :as _opts} _id-or-name, :as field-clause]
style]
(if-let [field-metadata (cond-> (resolve-field-metadata query stage-number field-clause)
join-alias (assoc :source-alias join-alias)
temporal-unit (assoc :unit temporal-unit)
binning (assoc ::binning binning)
source-field (assoc :fk-field-id source-field))]
(lib.metadata.calculation/display-name query stage-number field-metadata style)
;; mostly for the benefit of JS, which does not enforce the Malli schemas.
(i18n/tru "[Unknown Field]"))) | |
(defmethod lib.metadata.calculation/column-name-method :metadata/column
[_query _stage-number {field-name :name}]
field-name) | |
(defmethod lib.metadata.calculation/column-name-method :field
[query stage-number [_tag _id-or-name, :as field-clause]]
(if-let [field-metadata (resolve-field-metadata query stage-number field-clause)]
(lib.metadata.calculation/column-name query stage-number field-metadata)
;; mostly for the benefit of JS, which does not enforce the Malli schemas.
"unknown_field")) | |
(defmethod lib.metadata.calculation/display-info-method :metadata/column
[query stage-number field-metadata]
(merge
((get-method lib.metadata.calculation/display-info-method :default) query stage-number field-metadata)
;; if this column comes from a source Card (Saved Question/Model/etc.) use the name of the Card as the 'table' name
;; rather than the ACTUAL table name.
(when (= (:lib/source field-metadata) :source/card)
(when-let [card-id (:lib/card-id field-metadata)]
(when-let [card (lib.metadata/card query card-id)]
{:table {:name (:name card), :display-name (:name card)}}))))) | |
---------------------------------- Temporal Bucketing ---------------------------------------- | |
TODO -- it's a little silly to make this a multimethod I think since there are exactly two implementations of it, right? Or can expression and aggregation references potentially be temporally bucketed as well? Think about whether just making this a plain function like we did for [[metabase.lib.join/with-join-alias]] makes sense or not. | |
(defmethod lib.temporal-bucket/temporal-bucket-method :field [[_tag opts _id-or-name]] (:temporal-unit opts)) | |
(defmethod lib.temporal-bucket/temporal-bucket-method :metadata/column [metadata] (::temporal-unit metadata)) | |
(defmethod lib.temporal-bucket/with-temporal-bucket-method :field
[[_tag options id-or-name] unit]
;; if `unit` is an extraction unit like `:month-of-year`, then the `:effective-type` of the ref changes to
;; `:type/Integer` (month of year returns an int). We need to record the ORIGINAL effective type somewhere in case
;; we need to refer back to it, e.g. to see what temporal buckets are available if we want to change the unit, or if
;; we want to remove it later. We will record this with the key `::original-effective-type`. Note that changing the
;; unit multiple times should keep the original first value of `::original-effective-type`.
(if unit
(let [extraction-unit? (contains? lib.schema.temporal-bucketing/datetime-extraction-units unit)
original-effective-type ((some-fn ::original-effective-type :effective-type :base-type) options)
new-effective-type (if extraction-unit?
:type/Integer
original-effective-type)
options (assoc options
:temporal-unit unit
:effective-type new-effective-type
::original-effective-type original-effective-type)]
[:field options id-or-name])
;; `unit` is `nil`: remove the temporal bucket.
(let [options (if-let [original-effective-type (::original-effective-type options)]
(-> options
(assoc :effective-type original-effective-type)
(dissoc ::original-effective-type))
options)
options (dissoc options :temporal-unit)]
[:field options id-or-name]))) | |
(defmethod lib.temporal-bucket/with-temporal-bucket-method :metadata/column
[metadata unit]
(if unit
(assoc metadata
::temporal-unit unit
::original-effective-type ((some-fn ::original-effective-type :effective-type :base-type) metadata))
(dissoc metadata ::temporal-unit ::original-effective-type))) | |
(defmethod lib.temporal-bucket/available-temporal-buckets-method :field [query stage-number field-ref] (lib.temporal-bucket/available-temporal-buckets query stage-number (resolve-field-metadata query stage-number field-ref))) | |
(defn- fingerprint-based-default-unit [fingerprint]
(u/ignore-exceptions
(when-let [{:keys [earliest latest]} (-> fingerprint :type :type/DateTime)]
(let [days (shared.ut/day-diff (shared.ut/coerce-to-timestamp earliest)
(shared.ut/coerce-to-timestamp latest))]
(when-not (NaN? days)
(condp > days
1 :minute
31 :day
365 :week
:month)))))) | |
(defn- mark-unit [options option-key unit]
(cond->> options
(some #(= (:unit %) unit) options)
(mapv (fn [option]
(cond-> option
(contains? option option-key) (dissoc option option-key)
(= (:unit option) unit) (assoc option-key true)))))) | |
(defmethod lib.temporal-bucket/available-temporal-buckets-method :metadata/column
[_query _stage-number field-metadata]
(if (not= (:lib/source field-metadata) :source/expressions)
(let [effective-type ((some-fn :effective-type :base-type) field-metadata)
fingerprint-default (some-> field-metadata :fingerprint fingerprint-based-default-unit)]
(cond-> (cond
(isa? effective-type :type/DateTime) lib.temporal-bucket/datetime-bucket-options
(isa? effective-type :type/Date) lib.temporal-bucket/date-bucket-options
(isa? effective-type :type/Time) lib.temporal-bucket/time-bucket-options
:else [])
fingerprint-default (mark-unit :default fingerprint-default)
(::temporal-unit field-metadata) (mark-unit :selected (::temporal-unit field-metadata))))
[])) | |
---------------------------------------- Binning --------------------------------------------- | |
(defmethod lib.binning/binning-method :field
[field-clause]
(some-> field-clause
lib.options/options
:binning
(assoc :lib/type ::lib.binning/binning
:metadata-fn (fn [query stage-number]
(resolve-field-metadata query stage-number field-clause))))) | |
(defmethod lib.binning/binning-method :metadata/column
[metadata]
(some-> metadata
::binning
(assoc :lib/type ::lib.binning/binning
:metadata-fn (constantly metadata)))) | |
(defmethod lib.binning/with-binning-method :field [field-clause binning] (lib.options/update-options field-clause u/assoc-dissoc :binning binning)) | |
(defmethod lib.binning/with-binning-method :metadata/column [metadata binning] (u/assoc-dissoc metadata ::binning binning)) | |
(defmethod lib.binning/available-binning-strategies-method :field [query stage-number field-ref] (lib.binning/available-binning-strategies query stage-number (resolve-field-metadata query stage-number field-ref))) | |
(defmethod lib.binning/available-binning-strategies-method :metadata/column
[query _stage-number {:keys [effective-type fingerprint semantic-type] :as field-metadata}]
(if (not= (:lib/source field-metadata) :source/expressions)
(let [binning? (some-> query lib.metadata/database :features (contains? :binning))
fingerprint (get-in fingerprint [:type :type/Number])
existing (lib.binning/binning field-metadata)
strategies (cond
;; Abort if the database doesn't support binning, or this column does not have a defined range.
(not (and binning?
(:min fingerprint)
(:max fingerprint))) nil
(isa? semantic-type :type/Coordinate) (lib.binning/coordinate-binning-strategies)
(and (isa? effective-type :type/Number)
(not (isa? semantic-type :Relation/*))) (lib.binning/numeric-binning-strategies))]
;; TODO: Include the time and date binning strategies too; see metabase.api.table/assoc-field-dimension-options.
(for [strat strategies]
(cond-> strat
(lib.binning/strategy= strat existing) (assoc :selected true))))
[])) | |
(defmethod lib.ref/ref-method :field [field-clause] field-clause) | |
(defn- column-metadata->field-ref
[metadata]
(let [inherited-column? (when-not (::lib.card/force-broken-id-refs metadata)
(#{:source/card :source/native :source/previous-stage} (:lib/source metadata)))
options (merge {:lib/uuid (str (random-uuid))
:base-type (:base-type metadata)
:effective-type (column-metadata-effective-type metadata)}
;; This one deliberately comes first so it will be overwritten by current-join-alias.
;; We don't want both :source-field and :join-alias, though.
(when-let [source-alias (and (not inherited-column?)
(not (:fk-field-id metadata))
(not= :source/implicitly-joinable
(:lib/source metadata))
(:source-alias metadata))]
{:join-alias source-alias})
(when-let [join-alias (lib.join.util/current-join-alias metadata)]
{:join-alias join-alias})
(when-let [temporal-unit (::temporal-unit metadata)]
{:temporal-unit temporal-unit})
(when-let [original-effective-type (::original-effective-type metadata)]
{::original-effective-type original-effective-type})
(when-let [binning (::binning metadata)]
{:binning binning})
(when-let [source-field-id (:fk-field-id metadata)]
{:source-field source-field-id}))
id-or-name ((if inherited-column?
(some-fn :lib/desired-column-alias :name)
(some-fn :id :name))
metadata)]
[:field options id-or-name])) | |
(defmethod lib.ref/ref-method :metadata/column
[{source :lib/source, :as metadata}]
(case source
:source/aggregations (lib.aggregation/column-metadata->aggregation-ref metadata)
:source/expressions (lib.expression/column-metadata->expression-ref metadata)
;; `:source/fields`/`:source/breakouts` can hide the true origin of the column. Since it's impossible to break out
;; by aggregation references at the current stage, we only have to check if we break out by an expression
;; reference. `:lib/expression-name` is only set for expression references, so if it's set, we have to generate an
;; expression ref, otherwise we generate a normal field ref.
(:source/fields :source/breakouts)
(if (:lib/expression-name metadata)
(lib.expression/column-metadata->expression-ref metadata)
(column-metadata->field-ref metadata))
#_else
(column-metadata->field-ref metadata))) | |
Return the [[::lib.schema.metadata/column]] for all the expressions in a stage of a query. | (defn- expression-columns
[query stage-number]
(filter #(= (:lib/source %) :source/expressions)
(lib.metadata.calculation/visible-columns
query
stage-number
(lib.util/query-stage query stage-number)
{:include-joined? false
:include-expressions? true
:include-implicitly-joinable? false}))) |
(mu/defn with-fields :- ::lib.schema/query
"Specify the `:fields` for a query. Pass `nil` or an empty sequence to remove `:fields`."
([xs]
(fn [query stage-number]
(with-fields query stage-number xs)))
([query xs]
(with-fields query -1 xs))
([query :- ::lib.schema/query
stage-number :- :int
xs]
(let [xs (not-empty (mapv lib.ref/ref xs))
;; If any fields are specified, include all expressions not yet included.
expr-cols (expression-columns query stage-number)
;; Set of expr-cols which are *already* included.
included (into #{}
(keep #(lib.equality/find-matching-column query stage-number % expr-cols))
(or xs []))
;; Those expr-refs which must still be included.
to-add (remove included expr-cols)
xs (when xs (into xs (map lib.ref/ref) to-add))]
(lib.util/update-query-stage query stage-number u/assoc-dissoc :fields xs)))) | |
(mu/defn fields :- [:maybe [:ref ::lib.schema/fields]]
"Fetches the `:fields` for a query. Returns `nil` if there are no `:fields`. `:fields` should never be empty; this is
enforced by the Malli schema."
([query]
(fields query -1))
([query :- ::lib.schema/query
stage-number :- :int]
(:fields (lib.util/query-stage query stage-number)))) | |
(mu/defn fieldable-columns :- [:sequential ::lib.schema.metadata/column]
"Return a sequence of column metadatas for columns that you can specify in the `:fields` of a query. This is
basically just the columns returned by the source Table/Saved Question/Model or previous query stage.
Includes a `:selected?` key letting you know this column is already in `:fields` or not; if `:fields` is
unspecified, all these columns are returned by default, so `:selected?` is true for all columns (this is a little
strange but it matches the behavior of the QB UI)."
([query]
(fieldable-columns query -1))
([query :- ::lib.schema/query
stage-number :- :int]
(let [visible-columns (lib.metadata.calculation/visible-columns query
stage-number
(lib.util/query-stage query stage-number)
{:include-joined? false
:include-expressions? false
:include-implicitly-joinable? false})
selected-fields (fields query stage-number)]
(if (empty? selected-fields)
(mapv (fn [col]
(assoc col :selected? true))
visible-columns)
(lib.equality/mark-selected-columns query stage-number visible-columns selected-fields))))) | |
Given a query and stage, sets the | (defn- populate-fields-for-stage
[query stage-number]
(let [defaults (lib.metadata.calculation/default-columns-for-stage query stage-number)]
(lib.util/update-query-stage query stage-number assoc :fields (mapv lib.ref/ref defaults)))) |
If the given stage already has a | (defn- query-with-fields
[query stage-number]
(cond-> query
(not (:fields (lib.util/query-stage query stage-number))) (populate-fields-for-stage stage-number))) |
(defn- include-field [query stage-number column]
(let [populated (query-with-fields query stage-number)
field-refs (fields populated stage-number)
match-ref (lib.equality/find-matching-ref column field-refs)
column-ref (lib.ref/ref column)]
(if (and match-ref
(or (string? (last column-ref))
(integer? (last match-ref))))
;; If the column is already found, do nothing and return the original query.
query
(lib.util/update-query-stage populated stage-number update :fields conj column-ref)))) | |
(defn- add-field-to-join [query stage-number column]
(let [column-ref (lib.ref/ref column)
[join field] (first (for [join (lib.join/joins query stage-number)
:let [joinables (lib.join/joinable-columns query stage-number join)
field (lib.equality/find-matching-column
query stage-number column-ref joinables)]
:when field]
[join field]))
join-fields (lib.join/join-fields join)]
;; Nothing to do if it's already selected, or if this join already has :fields :all.
;; Otherwise, append it to the list of fields.
(if (or (= join-fields :all)
(and field
(not= join-fields :none)
(lib.equality/find-matching-ref field join-fields)))
query
(lib.remove-replace/replace-join query stage-number join
(lib.join/with-join-fields join
(if (= join-fields :none)
[column]
(conj join-fields column))))))) | |
(defn- native-query-fields-edit-error [] (i18n/tru "Fields cannot be adjusted on native queries. Either edit the native query, or save this question and edit the fields in a GUI question based on this one.")) | |
(mu/defn add-field :- ::lib.schema/query
"Adds a given field (`ColumnMetadata`, as returned from eg. [[visible-columns]]) to the fields returned by the query.
Exactly what this means depends on the source of the field:
- Source table/card, previous stage of the query, custom expression, aggregation or breakout:
- Add it to the `:fields` list
- If `:fields` is missing, it's implicitly `:all`, so do nothing.
- Implicit join: add it to the `:fields` list; query processor will do the right thing with it.
- Explicit join: add it to that join's `:fields` list."
[query :- ::lib.schema/query
stage-number :- :int
column :- lib.metadata.calculation/ColumnMetadataWithSource]
(let [stage (lib.util/query-stage query stage-number)
source (:lib/source column)]
(-> (case source
(:source/table-defaults
:source/fields
:source/card
:source/previous-stage
:source/expressions
:source/aggregations
:source/breakouts) (cond-> query
(contains? stage :fields) (include-field stage-number column))
:source/joins (add-field-to-join query stage-number column)
:source/implicitly-joinable (include-field query stage-number column)
:source/native (throw (ex-info (native-query-fields-edit-error) {:query query :stage stage-number}))
;; Default case - do nothing if we don't know about the incoming value.
;; Generates a warning, as we should aim to capture all the :source/* values here.
(do
(log/warn (i18n/tru "Cannot add-field with unknown source {0}" (pr-str source)))
query))
;; Then drop any redundant :fields clauses.
lib.remove-replace/normalize-fields-clauses))) | |
(defn- remove-matching-ref [column refs]
(let [match (lib.equality/find-matching-ref column refs)]
(remove #(= % match) refs))) | |
This is called only for fields that plausibly need removing. If the stage has no | (defn- exclude-field
[query stage-number column]
(let [old-fields (-> (query-with-fields query stage-number)
(lib.util/query-stage stage-number)
:fields)
new-fields (remove-matching-ref column old-fields)]
(cond-> query
;; If we couldn't find the field, return the original query unchanged.
(< (count new-fields) (count old-fields)) (lib.util/update-query-stage stage-number assoc :fields new-fields)))) |
(defn- remove-field-from-join [query stage-number column]
(let [join (lib.join/resolve-join query stage-number (::lib.join/join-alias column))
join-fields (lib.join/join-fields join)]
(if (or (nil? join-fields)
(= join-fields :none))
;; Nothing to do if there's already no join fields.
query
(let [resolved-join-fields (if (= join-fields :all)
(map lib.ref/ref (lib.metadata.calculation/returned-columns query stage-number join))
join-fields)
removed (remove-matching-ref column resolved-join-fields)]
(cond-> query
;; If we actually removed a field, replace the join. Otherwise return the query unchanged.
(< (count removed) (count resolved-join-fields))
(lib.remove-replace/replace-join stage-number join (lib.join/with-join-fields join removed))))))) | |
(mu/defn remove-field :- ::lib.schema/query
"Removes the field (a `ColumnMetadata`, as returned from eg. [[visible-columns]]) from those fields returned by the
query. Exactly what this means depends on the source of the field:
- Source table/card, previous stage, custom expression, aggregations or breakouts:
- If `:fields` is missing, it's implicitly `:all` - populate it with all the columns except the removed one.
- Remove the target column from the `:fields` list
- Implicit join: remove it from the `:fields` list; do nothing if it's not there.
- (An implicit join only exists in the `:fields` clause, so if it's not there then it's not anywhere.)
- Explicit join: remove it from that join's `:fields` list (handle `:fields :all` like for source tables)."
[query :- ::lib.schema/query
stage-number :- :int
column :- lib.metadata.calculation/ColumnMetadataWithSource]
(let [source (:lib/source column)]
(-> (case source
(:source/table-defaults
:source/fields
:source/breakouts
:source/aggregations
:source/expressions
:source/card
:source/previous-stage
:source/implicitly-joinable) (exclude-field query stage-number column)
:source/joins (remove-field-from-join query stage-number column)
:source/native (throw (ex-info (native-query-fields-edit-error)
{:query query :stage stage-number}))
;; Default case: do nothing and return the query unchaged.
;; Generate a warning - we should aim to capture every `:source/*` value above.
(do
(log/warn (i18n/tru "Cannot remove-field with unknown source {0}" (pr-str source)))
query))
;; Then drop any redundant :fields clauses.
lib.remove-replace/normalize-fields-clauses))) | |
TODO: Refactor this away? The special handling for aggregations is strange. | (mu/defn find-visible-column-for-ref :- [:maybe ::lib.schema.metadata/column]
"Return the visible column in `query` at `stage-number` referenced by `field-ref`. If `stage-number` is omitted, the
last stage is used. This is currently only meant for use with `:field` clauses."
([query field-ref]
(find-visible-column-for-ref query -1 field-ref))
([query :- ::lib.schema/query
stage-number :- :int
field-ref :- some?]
(let [stage (lib.util/query-stage query stage-number)
;; not 100% sure why, but [[lib.metadata.calculation/visible-columns]] doesn't seem to return aggregations,
;; so we have to use [[lib.metadata.calculation/returned-columns]] instead.
columns ((if (= (lib.dispatch/dispatch-value field-ref) :aggregation)
lib.metadata.calculation/returned-columns
lib.metadata.calculation/visible-columns)
query stage-number stage)]
(lib.equality/find-matching-column query stage-number field-ref columns)))) |
Return true if field is a JSON field, false if not. | (defn json-field? [field] (some? (:nfc-path field))) |
yes, this is intentionally different from the version in | (mr/def ::field-values-search-info.has-field-values [:enum :list :search :none]) |
(mr/def ::field-values-search-info [:map [:field-id [:maybe [:ref ::lib.schema.id/field]]] [:search-field-id [:maybe [:ref ::lib.schema.id/field]]] [:has-field-values [:ref ::field-values-search-info.has-field-values]]]) | |
(mu/defn infer-has-field-values :- ::field-values-search-info.has-field-values
"Determine the value of `:has-field-values` we should return for column metadata for frontend consumption to power
filter search widgets, either when returned by the the REST API or in MLv2 with [[field-values-search-info]].
Note that this value is not necessarily the same as the value of `has_field_values` in the application database.
`has_field_values` may be unset, in which case we will try to infer it. `:auto-list` is not currently understood by
the FE filter stuff, so we will instead return `:list`; the distinction is not important to it anyway."
[{:keys [has-field-values], :as field} :- [:map
;; this doesn't use `::lib.schema.metadata/column` because it's stricter
;; than we need and the REST API calls this function with optimized Field
;; maps that don't include some keys like `:name`
[:base-type {:optional true} [:maybe ::lib.schema.common/base-type]]
[:effective-type {:optional true} [:maybe ::lib.schema.common/base-type]]
[:has-field-values {:optional true} [:maybe ::lib.schema.metadata/column.has-field-values]]]]
(cond
;; if `has_field_values` is set in the DB, use that value; but if it's `auto-list`, return the value as `list` to
;; avoid confusing FE code, which can remain blissfully unaware that `auto-list` is a thing
(= has-field-values :auto-list) :list
has-field-values has-field-values
;; otherwise if it does not have value set in DB we will infer it
(lib.types.isa/searchable? field) :search
:else :none)) | |
(mu/defn ^:private remapped-field :- [:maybe ::lib.schema.metadata/column]
[metadata-providerable :- ::lib.schema.metadata/metadata-providerable
column :- ::lib.schema.metadata/column]
(when-let [remap-field-id (get-in column [:lib/external-remap :field-id])]
(lib.metadata/field metadata-providerable remap-field-id))) | |
(mu/defn ^:private search-field :- [:maybe ::lib.schema.metadata/column]
[metadata-providerable :- ::lib.schema.metadata/metadata-providerable
column :- ::lib.schema.metadata/column]
;; ignore remappings for PK columns.
(let [col (or (when (lib.types.isa/primary-key? column)
column)
(remapped-field metadata-providerable column)
column)]
(when (lib.types.isa/searchable? col)
col))) | |
(mu/defn field-values-search-info :- ::field-values-search-info
"Info about whether the column in question has FieldValues associated with it for purposes of powering a search
widget in the QB filter modals."
[metadata-providerable :- ::lib.schema.metadata/metadata-providerable
column :- ::lib.schema.metadata/column]
(when column
(let [column-field-id (:id column)
search-field-id (:id (search-field metadata-providerable column))]
{:field-id (when (int? column-field-id) column-field-id)
:search-field-id (when (int? search-field-id) search-field-id)
:has-field-values (if column
(infer-has-field-values column)
:none)}))) | |
(ns metabase.lib.filter (:refer-clojure :exclude [filter and or not = < <= > >= not-empty case]) (:require [inflections.core :as inflections] [medley.core :as m] [metabase.lib.common :as lib.common] [metabase.lib.convert :as lib.convert] [metabase.lib.dispatch :as lib.dispatch] [metabase.lib.equality :as lib.equality] [metabase.lib.filter.operator :as lib.filter.operator] [metabase.lib.hierarchy :as lib.hierarchy] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.options :as lib.options] [metabase.lib.ref :as lib.ref] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.expression :as lib.schema.expression] [metabase.lib.schema.filter :as lib.schema.filter] [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.lib.schema.temporal-bucketing :as lib.schema.temporal-bucketing] [metabase.lib.temporal-bucket :as lib.temporal-bucket] [metabase.lib.types.isa :as lib.types.isa] [metabase.lib.util :as lib.util] [metabase.mbql.normalize :as mbql.normalize] [metabase.mbql.util :as mbql.u] [metabase.shared.util.i18n :as i18n] [metabase.shared.util.time :as shared.ut] [metabase.util :as u] [metabase.util.malli :as mu])) | |
(doseq [tag [:and :or]] (lib.hierarchy/derive tag ::compound)) | |
(doseq [tag [:= :!=]] (lib.hierarchy/derive tag ::varargs)) | |
(doseq [tag [:< :<= :> :>= :starts-with :ends-with :contains :does-not-contain]] (lib.hierarchy/derive tag ::binary)) | |
(doseq [tag [:is-null :not-null :is-empty :not-empty :not]] (lib.hierarchy/derive tag ::unary)) | |
(defmethod lib.metadata.calculation/describe-top-level-key-method :filters
[query stage-number _key]
(when-let [filters (clojure.core/not-empty (:filters (lib.util/query-stage query stage-number)))]
(i18n/tru "Filtered by {0}"
(lib.util/join-strings-with-conjunction
(i18n/tru "and")
(for [filter filters]
(lib.metadata.calculation/display-name query stage-number filter :long)))))) | |
Display names for filter clauses are only really used in generating descriptions for | |
(defmethod lib.metadata.calculation/display-name-method ::compound
[query stage-number [tag _opts & subclauses] style]
(lib.util/join-strings-with-conjunction
(clojure.core/case tag
:and (i18n/tru "and")
:or (i18n/tru "or"))
(for [clause subclauses]
(lib.metadata.calculation/display-name query stage-number clause style)))) | |
(defmethod lib.metadata.calculation/display-name-method ::varargs
[query stage-number expr style]
(let [->display-name #(lib.metadata.calculation/display-name query stage-number % style)
->temporal-name lib.temporal-bucket/describe-temporal-pair
numeric? #(clojure.core/and (lib.util/original-isa? % :type/Number)
(lib.util/clause? %)
(-> (lib.metadata.calculation/metadata query stage-number %)
lib.types.isa/id?
clojure.core/not))
temporal? #(lib.util/original-isa? % :type/Temporal)
unit-is (fn [unit-or-units]
(let [units (set (u/one-or-many unit-or-units))]
(fn [a]
(clojure.core/and
(temporal? a)
(lib.util/clause? a)
(clojure.core/contains? units (:temporal-unit (second a)))))))
->unbucketed-display-name #(-> %
(update 1 dissoc :temporal-unit)
->display-name)
->bucket-name #(-> %
second
:temporal-unit
lib.temporal-bucket/describe-temporal-unit
u/lower-case-en)]
(mbql.u/match-one expr
[:= _ (a :guard numeric?) b]
(i18n/tru "{0} is equal to {1}" (->display-name a) (->display-name b))
[:= _ (a :guard (unit-is lib.schema.temporal-bucketing/datetime-truncation-units)) (b :guard string?)]
(i18n/tru "{0} is {1}" (->unbucketed-display-name a) (shared.ut/format-relative-date-range b 0 (:temporal-unit (second a)) nil nil {:include-current true}))
[:= _ (a :guard temporal?) (b :guard (some-fn int? string?))]
(i18n/tru "{0} is on {1}" (->display-name a) (->temporal-name a b))
[:!= _ (a :guard numeric?) b]
(i18n/tru "{0} is not equal to {1}" (->display-name a) (->display-name b))
[:!= _ (a :guard (unit-is :day-of-week)) (b :guard (some-fn int? string?))]
(i18n/tru "{0} excludes {1}" (->unbucketed-display-name a) (inflections/plural (->temporal-name a b)))
[:!= _ (a :guard (unit-is :month-of-year)) (b :guard (some-fn int? string?))]
(i18n/tru "{0} excludes each {1}" (->unbucketed-display-name a) (->temporal-name a b))
[:!= _ (a :guard (unit-is :quarter-of-year)) (b :guard (some-fn int? string?))]
(i18n/tru "{0} excludes {1} each year" (->unbucketed-display-name a) (->temporal-name a b))
[:!= _ (a :guard (unit-is :hour-of-day)) (b :guard (some-fn int? string?))]
(i18n/tru "{0} excludes the hour of {1}" (->unbucketed-display-name a) (->temporal-name a b))
[:!= _ (a :guard temporal?) (b :guard (some-fn int? string?))]
(i18n/tru "{0} excludes {1}" (->display-name a) (->temporal-name a b))
[:= _ a (b :guard string?)]
(i18n/tru "{0} is {1}" (->display-name a) b)
[:= _ a b]
(i18n/tru "{0} is {1}" (->display-name a) (->display-name b))
[:!= _ a (b :guard string?)]
(i18n/tru "{0} is not {1}" (->display-name a) b)
[:!= _ a b]
(i18n/tru "{0} is not {1}" (->display-name a) (->display-name b))
[:= _ (a :guard numeric?) & args]
(i18n/tru "{0} is equal to {1} selections" (->display-name a) (count args))
[:!= _ (a :guard numeric?) & args]
(i18n/tru "{0} is not equal to {1} selections" (->display-name a) (count args))
[:!= _ (a :guard temporal?) & args]
(i18n/tru "{0} excludes {1} {2} selections" (->unbucketed-display-name a) (count args) (->bucket-name a))
[:= _ a & args]
(i18n/tru "{0} is {1} selections" (->display-name a) (count args))
[:!= _ a & args]
(i18n/tru "{0} is not {1} selections" (->display-name a) (count args))))) | |
(defmethod lib.metadata.calculation/display-name-method ::binary
[query stage-number expr style]
(let [->display-name #(lib.metadata.calculation/display-name query stage-number % style)
->temporal-name #(shared.ut/format-unit % nil)
temporal? #(lib.util/original-isa? % :type/Temporal)]
(mbql.u/match-one expr
[:< _ (x :guard temporal?) (y :guard string?)]
(i18n/tru "{0} is before {1}" (->display-name x) (->temporal-name y))
[:< _ x y]
(i18n/tru "{0} is less than {1}" (->display-name x) (->display-name y))
[:<= _ x y]
(i18n/tru "{0} is less than or equal to {1}" (->display-name x) (->display-name y))
[:> _ (x :guard temporal?) (y :guard string?)]
(i18n/tru "{0} is after {1}" (->display-name x) (->temporal-name y))
[:> _ x y]
(i18n/tru "{0} is greater than {1}" (->display-name x) (->display-name y))
[:>= _ x y]
(i18n/tru "{0} is greater than or equal to {1}" (->display-name x) (->display-name y))
[:starts-with _ x (y :guard string?)]
(i18n/tru "{0} starts with {1}" (->display-name x) y)
[:starts-with _ x y]
(i18n/tru "{0} starts with {1}" (->display-name x) (->display-name y))
[:ends-with _ x (y :guard string?)]
(i18n/tru "{0} ends with {1}" (->display-name x) y)
[:ends-with _ x y]
(i18n/tru "{0} ends with {1}" (->display-name x) (->display-name y))
[:contains _ x (y :guard string?)]
(i18n/tru "{0} contains {1}" (->display-name x) y)
[:contains _ x y]
(i18n/tru "{0} contains {1}" (->display-name x) (->display-name y))
[:does-not-contain _ x (y :guard string?)]
(i18n/tru "{0} does not contain {1}" (->display-name x) y)
[:does-not-contain _ x y]
(i18n/tru "{0} does not contain {1}" (->display-name x) (->display-name y))))) | |
(defmethod lib.metadata.calculation/display-name-method :between
[query stage-number expr style]
(let [->display-name #(lib.metadata.calculation/display-name query stage-number % style)
->unbucketed-display-name #(-> %
(update 1 dissoc :temporal-unit)
->display-name)
temporal? #(lib.util/original-isa? % :type/Temporal)]
(mbql.u/match-one expr
[:between _ (x :guard temporal?) (y :guard string?) (z :guard string?)]
(i18n/tru "{0} is {1}"
(->unbucketed-display-name x)
(shared.ut/format-diff y z))
[:between _
[:+ _ (x :guard temporal?) [:interval _ n unit]]
[:relative-datetime _ n2 unit2]
[:relative-datetime _ 0 _]]
(i18n/tru "{0} is in the {1}, starting {2} ago"
(->display-name x)
(u/lower-case-en (lib.temporal-bucket/describe-temporal-interval n2 unit2))
(inflections/pluralize n (name unit)))
[:between _
[:+ _ (x :guard temporal?) [:interval _ n unit]]
[:relative-datetime _ 0 _]
[:relative-datetime _ n2 unit2]]
(i18n/tru "{0} is in the {1}, starting {2} from now"
(->display-name x)
(u/lower-case-en (lib.temporal-bucket/describe-temporal-interval n2 unit2))
(inflections/pluralize (abs n) (name unit)))
[:between _ x y z]
(i18n/tru "{0} is between {1} and {2}"
(->display-name x)
(->display-name y)
(->display-name z))))) | |
(defmethod lib.metadata.calculation/display-name-method :inside
[query stage-number [_tag opts lat-expr lon-expr lat-max lon-min lat-min lon-max] style]
(lib.metadata.calculation/display-name query stage-number
[:and opts
[:between opts lat-expr lat-min lat-max]
[:between opts lon-expr lon-min lon-max]]
style)) | |
(defmethod lib.metadata.calculation/display-name-method ::unary
[query stage-number [tag _opts expr] style]
(let [expr (lib.metadata.calculation/display-name query stage-number expr style)]
;; for whatever reason the descriptions of for `:is-null` and `:not-null` is "is empty" and "is not empty".
(clojure.core/case tag
:is-null (i18n/tru "{0} is empty" expr)
:not-null (i18n/tru "{0} is not empty" expr)
:is-empty (i18n/tru "{0} is empty" expr)
:not-empty (i18n/tru "{0} is not empty" expr)
;; TODO -- This description is sorta wack, we should use [[metabase.mbql.util/negate-filter-clause]] to negate
;; `expr` and then generate a description. That would require porting that stuff to pMBQL tho.
:not (i18n/tru "not {0}" expr)))) | |
(defmethod lib.metadata.calculation/display-name-method :time-interval
[query stage-number [_tag _opts expr n unit] style]
(if (clojure.core/or
(clojure.core/= n :current)
(clojure.core/and
(clojure.core/= (abs n) 1)
(clojure.core/= unit :day)))
(i18n/tru "{0} is {1}"
(lib.metadata.calculation/display-name query stage-number expr style)
(u/lower-case-en (lib.temporal-bucket/describe-temporal-interval n unit)))
(i18n/tru "{0} is in the {1}"
(lib.metadata.calculation/display-name query stage-number expr style)
(u/lower-case-en (lib.temporal-bucket/describe-temporal-interval n unit))))) | |
(defmethod lib.metadata.calculation/display-name-method :relative-datetime
[_query _stage-number [_tag _opts n unit] _style]
(i18n/tru "{0}" (lib.temporal-bucket/describe-temporal-interval n unit))) | |
(defmethod lib.metadata.calculation/display-name-method :interval
[_query _stage-number [_tag _opts n unit] _style]
(i18n/tru "{0}" (lib.temporal-bucket/describe-temporal-interval n unit))) | |
(lib.common/defop and [x y & more]) (lib.common/defop or [x y & more]) (lib.common/defop not [x]) (lib.common/defop = [x y & more]) (lib.common/defop != [x y & more]) (lib.common/defop < [x y]) (lib.common/defop <= [x y]) (lib.common/defop > [x y]) (lib.common/defop >= [x y]) (lib.common/defop between [x lower upper]) (lib.common/defop inside [lat lon lat-max lon-min lat-min lon-max]) (lib.common/defop is-null [x]) (lib.common/defop not-null [x]) (lib.common/defop is-empty [x]) (lib.common/defop not-empty [x]) (lib.common/defop starts-with [whole part]) (lib.common/defop ends-with [whole part]) (lib.common/defop contains [whole part]) (lib.common/defop does-not-contain [whole part]) (lib.common/defop time-interval [x amount unit]) (lib.common/defop segment [segment-id]) | |
(mu/defn filter :- :metabase.lib.schema/query
"Sets `boolean-expression` as a filter on `query`."
([query :- :metabase.lib.schema/query
boolean-expression]
(metabase.lib.filter/filter query nil boolean-expression))
([query :- :metabase.lib.schema/query
stage-number :- [:maybe :int]
boolean-expression]
;; if this is a Segment metadata, convert it to `:segment` MBQL clause before adding
(if (clojure.core/= (lib.dispatch/dispatch-value boolean-expression) :metadata/segment)
(recur query stage-number (lib.ref/ref boolean-expression))
(let [stage-number (clojure.core/or stage-number -1)
new-filter (lib.common/->op-arg boolean-expression)]
(lib.util/update-query-stage query stage-number update :filters (fnil conj []) new-filter))))) | |
(mu/defn filters :- [:maybe [:ref ::lib.schema/filters]]
"Returns the current filters in stage with `stage-number` of `query`.
If `stage-number` is omitted, the last stage is used. Logicaly, the
filter attached to the query is the conjunction of the expressions
in the returned list. If the returned list is empty, then there is no
filter attached to the query.
See also [[metabase.lib.util/query-stage]]."
([query :- :metabase.lib.schema/query] (filters query nil))
([query :- :metabase.lib.schema/query
stage-number :- [:maybe :int]]
(clojure.core/not-empty (:filters (lib.util/query-stage query (clojure.core/or stage-number -1)))))) | |
Malli schema for ColumnMetadata extended with the list of applicable operators. | (def ColumnWithOperators
[:merge
[:ref ::lib.schema.metadata/column]
[:map
[:operators {:optional true} [:sequential [:ref ::lib.schema.filter/operator]]]]]) |
(mu/defn filterable-column-operators :- [:maybe [:sequential ::lib.schema.filter/operator]] "Returns the operators for which `filterable-column` is applicable." [filterable-column :- ColumnWithOperators] (:operators filterable-column)) | |
(mu/defn add-column-operators :- ColumnWithOperators
"Extend the column metadata with the available operators if any."
[column :- ::lib.schema.metadata/column]
(let [operators (lib.filter.operator/filter-operators column)]
(m/assoc-some column :operators (clojure.core/not-empty operators)))) | |
Returns the first argument of | (defn- leading-ref
[a-filter]
(when-let [leading-arg (clojure.core/and (lib.util/clause? a-filter)
(get a-filter 2))]
(when (lib.util/ref-clause? leading-arg)
leading-arg))) |
(mu/defn filterable-columns :- [:sequential ColumnWithOperators]
"Get column metadata for all the columns that can be filtered in
the stage number `stage-number` of the query `query`
If `stage-number` is omitted, the last stage is used.
The rules for determining which columns can be broken out by are as follows:
1. custom `:expressions` in this stage of the query
2. Fields 'exported' by the previous stage of the query, if there is one;
otherwise Fields from the current `:source-table`
3. Fields exported by explicit joins
4. Fields in Tables that are implicitly joinable."
([query :- ::lib.schema/query]
(filterable-columns query -1))
([query :- ::lib.schema/query
stage-number :- :int]
(let [stage (lib.util/query-stage query stage-number)
columns (sequence
(comp (map add-column-operators)
(clojure.core/filter :operators))
(lib.metadata.calculation/visible-columns query stage-number stage))
existing-filters (filters query stage-number)]
(cond
(empty? columns)
nil
(empty? existing-filters)
(vec columns)
:else
(let [matching (group-by
(fn [filter-pos]
(when-let [a-ref (leading-ref (get existing-filters filter-pos))]
(lib.equality/find-matching-column query stage-number a-ref columns)))
(range (count existing-filters)))]
(mapv #(let [positions (matching %)]
(cond-> %
positions (assoc :filter-positions positions)))
columns)))))) | |
(mu/defn filter-clause :- ::lib.schema.expression/boolean
"Returns a standalone filter clause for a `filter-operator`,
a `column`, and arguments."
[filter-operator :- [:or ::lib.schema.filter/operator :keyword :string]
column :- ::lib.schema.metadata/column
& args]
(let [tag (if (map? filter-operator)
(:short filter-operator)
(keyword filter-operator))]
(lib.options/ensure-uuid (into [tag {} (lib.common/->op-arg column)]
(map lib.common/->op-arg args))))) | |
(mu/defn filter-operator :- ::lib.schema.filter/operator
"Return the filter operator of the boolean expression `filter-clause`
at `stage-number` in `query`.
If `stage-number` is omitted, the last stage is used."
([query a-filter-clause]
(filter-operator query -1 a-filter-clause))
([query :- ::lib.schema/query
stage-number :- :int
a-filter-clause :- ::lib.schema.expression/boolean]
(let [[op _ first-arg] a-filter-clause
stage (lib.util/query-stage query stage-number)
columns (lib.metadata.calculation/visible-columns query stage-number stage)
col (lib.equality/find-matching-column query stage-number first-arg columns)]
(clojure.core/or (m/find-first #(clojure.core/= (:short %) op)
(lib.filter.operator/filter-operators col))
(lib.filter.operator/operator-def op))))) | |
(mu/defn find-filter-for-legacy-filter :- [:maybe ::lib.schema.expression/boolean]
"Return the filter clause in `query` at stage `stage-number` matching the legacy
filter clause `legacy-filter`, if any."
([query :- ::lib.schema/query
legacy-filter]
(find-filter-for-legacy-filter query -1 legacy-filter))
([query :- ::lib.schema/query
stage-number :- :int
legacy-filter :- some?]
(let [legacy-filter (mbql.normalize/normalize-fragment [:query :filter] legacy-filter)
query-filters (vec (filters query stage-number))
matching-filters (clojure.core/filter #(clojure.core/= (mbql.normalize/normalize-fragment
[:query :filter]
(lib.convert/->legacy-MBQL %))
legacy-filter)
query-filters)]
(when (seq matching-filters)
(if (next matching-filters)
(throw (ex-info "Multiple matching filters found" {:legacy-filter legacy-filter
:query-filters query-filters
:matching-filters matching-filters}))
(first matching-filters)))))) | |
TODO: Refactor this away - handle legacy refs in | (mu/defn find-filterable-column-for-legacy-ref :- [:maybe ColumnWithOperators]
"Given a legacy `:field` reference, return the filterable [[ColumnWithOperators]] that best fits it."
([query legacy-ref]
(find-filterable-column-for-legacy-ref query -1 legacy-ref))
([query :- ::lib.schema/query
stage-number :- :int
legacy-ref :- some?]
(let [a-ref (lib.convert/legacy-ref->pMBQL query stage-number legacy-ref)
columns (filterable-columns query stage-number)]
(lib.equality/find-matching-column a-ref columns)))) |
(def ^:private FilterParts [:map [:lib/type [:= :mbql/filter-parts]] [:operator ::lib.schema.filter/operator] [:options ::lib.schema.common/options] [:column [:maybe ColumnWithOperators]] [:args [:sequential :any]]]) | |
(mu/defn filter-parts :- FilterParts
"Return the parts of the filter clause `a-filter-clause` in query `query` at stage `stage-number`.
Might obsolate [[filter-operator]]."
([query a-filter-clause]
(filter-parts query -1 a-filter-clause))
([query :- ::lib.schema/query
stage-number :- :int
a-filter-clause :- ::lib.schema.expression/boolean]
(let [[op options first-arg & rest-args] a-filter-clause
stage (lib.util/query-stage query stage-number)
columns (lib.metadata.calculation/visible-columns query stage-number stage)
col (lib.equality/find-matching-column query stage-number first-arg columns)]
{:lib/type :mbql/filter-parts
:operator (clojure.core/or (m/find-first #(clojure.core/= (:short %) op)
(lib.filter.operator/filter-operators col))
(lib.filter.operator/operator-def op))
:options options
:column (some-> col add-column-operators)
:args (vec rest-args)}))) | |
(ns metabase.lib.filter.operator (:require [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.filter :as lib.schema.filter] [metabase.lib.types.isa :as lib.types.isa] [metabase.shared.util.i18n :as i18n] [metabase.util :as u] [metabase.util.malli :as mu])) | |
(mu/defn operator-def :- ::lib.schema.filter/operator
"Get a filter operator definition for the MBQL filter with `tag`, e.g. `:=`. In some cases various tags have alternate
display names used for different situations e.g. for numbers vs temporal values; pass in the
`display-name-style` to choose a non-default display-name."
([tag]
(operator-def tag :default))
([tag display-name-style]
{:lib/type :operator/filter
:short tag
:display-name-variant display-name-style})) | |
(def ^:private key-operators [(operator-def :=) (operator-def :!=) (operator-def :>) (operator-def :<) (operator-def :between) (operator-def :>=) (operator-def :<=) (operator-def :is-null :is-empty) (operator-def :not-null :not-empty)]) | |
(def ^:private location-operators [(operator-def :=) (operator-def :!=) (operator-def :is-empty) (operator-def :not-empty) (operator-def :contains) (operator-def :does-not-contain) (operator-def :starts-with) (operator-def :ends-with)]) | |
(def ^:private temporal-operators [(operator-def :!= :excludes) (operator-def :=) (operator-def :< :before) (operator-def :> :after) (operator-def :between) (operator-def :is-null :is-empty) (operator-def :not-null :not-empty)]) | |
(def ^:private coordinate-operators [(operator-def :=) (operator-def :!=) (operator-def :inside) (operator-def :>) (operator-def :<) (operator-def :between) (operator-def :>=) (operator-def :<=)]) | |
(def ^:private number-operators [(operator-def := :equal-to) (operator-def :!= :not-equal-to) (operator-def :>) (operator-def :<) (operator-def :between) (operator-def :>=) (operator-def :<=) (operator-def :is-null :is-empty) (operator-def :not-null :not-empty)]) | |
(def ^:private text-operators [(operator-def :=) (operator-def :!=) (operator-def :contains) (operator-def :does-not-contain) (operator-def :is-null) (operator-def :not-null) (operator-def :is-empty) (operator-def :not-empty) (operator-def :starts-with) (operator-def :ends-with)]) | |
(def ^:private text-like-operators [(operator-def :=) (operator-def :!=) (operator-def :is-null) (operator-def :not-null) (operator-def :is-empty) (operator-def :not-empty)]) | |
(def ^:private boolean-operators [(operator-def :=) (operator-def :is-null :is-empty) (operator-def :not-null :not-empty)]) | |
(def ^:private default-operators [(operator-def :=) (operator-def :!=) (operator-def :is-null) (operator-def :not-null)]) | |
Operators that should be listed as options in join conditions. | (def join-operators [(assoc (operator-def :=) :default true) (operator-def :>) (operator-def :<) (operator-def :>=) (operator-def :<=) (operator-def :!=)]) |
(mu/defn filter-operators :- [:sequential ::lib.schema.filter/operator]
"The list of available filter operators.
The order of operators is relevant for the front end.
There are slight differences between names and ordering for the different base types."
[column :- lib.metadata/ColumnMetadata]
;; The order of these clauses is important since we want to match the most relevant type
;; the order is different than `lib.types.isa/field-type` as filters need to operate
;; on the effective-type rather than the semantic-type, eg boolean and number cannot become
;; string if semantic type is type/Category
(condp lib.types.isa/field-type? column
:metabase.lib.types.constants/primary_key key-operators
:metabase.lib.types.constants/foreign_key key-operators
:metabase.lib.types.constants/location location-operators
:metabase.lib.types.constants/temporal temporal-operators
:metabase.lib.types.constants/coordinate coordinate-operators
:metabase.lib.types.constants/number number-operators
:metabase.lib.types.constants/boolean boolean-operators
:metabase.lib.types.constants/string text-operators
:metabase.lib.types.constants/string_like text-like-operators
;; default
default-operators)) | |
(mu/defn ^:private filter-operator-long-display-name :- ::lib.schema.common/non-blank-string
[tag :- :keyword
display-name-variant :- :keyword]
(case tag
:= (case display-name-variant
:equal-to (i18n/tru "Equal to")
:default (i18n/tru "Is"))
:!= (case display-name-variant
:not-equal-to (i18n/tru "Not equal to")
:excludes (i18n/tru "Excludes")
:default (i18n/tru "Is not"))
:> (case display-name-variant
:after (i18n/tru "After")
:default (i18n/tru "Greater than"))
:< (case display-name-variant
:before (i18n/tru "Before")
:default (i18n/tru "Less than"))
:>= (case display-name-variant
:default (i18n/tru "Greater than or equal to"))
:<= (case display-name-variant
:default (i18n/tru "Less than or equal to"))
:between (case display-name-variant
:default (i18n/tru "Between"))
:is-null (case display-name-variant
:is-empty (i18n/tru "Is empty")
:default (i18n/tru "Is null"))
:not-null (case display-name-variant
:not-empty (i18n/tru "Not empty")
:default (i18n/tru "Not null"))
:is-empty (case display-name-variant
:default (i18n/tru "Is empty"))
:not-empty (case display-name-variant
:default (i18n/tru "Not empty"))
:contains (case display-name-variant
:default (i18n/tru "Contains"))
:does-not-contain (case display-name-variant
:default (i18n/tru "Does not contain"))
:starts-with (case display-name-variant
:default (i18n/tru "Starts with"))
:ends-with (case display-name-variant
:default (i18n/tru "Ends with"))
:inside (case display-name-variant
:default (i18n/tru "Inside")))) | |
(mu/defn ^:private filter-operator-display-name :- ::lib.schema.common/non-blank-string
[tag :- :keyword
display-name-variant :- :keyword]
(case tag
:= "="
:!= "≠"
:> ">"
:< "<"
:>= "≥"
:<= "≤"
(filter-operator-long-display-name tag display-name-variant))) | |
(defmethod lib.metadata.calculation/display-name-method :operator/filter
[_query _stage-number {short-name :short, :keys [display-name-variant]} display-name-style]
(case display-name-style
:default (filter-operator-display-name short-name display-name-variant)
:long (filter-operator-long-display-name short-name display-name-variant))) | |
(defmethod lib.metadata.calculation/display-info-method :operator/filter
[_query _stage-number {short-name :short, :keys [display-name-variant default]}]
(cond-> {:short-name (u/qualified-name short-name)
:display-name (filter-operator-display-name short-name display-name-variant)
:long-display-name (filter-operator-long-display-name short-name display-name-variant)}
default (assoc :default true))) | |
Conveniences for adding or updating certain types of filters, used to power the drag-and-drop 'brush' zoom-in filtering in the frontend. For example the user might drag the mouse between two points on a timeseries visualization, and we use these functions to update the query accordingly and add a filter between the start and end points. There are three types of brush filters:
If there is no existing filter on the column(s), these add a new filter. Existing filters are replaced. | (ns metabase.lib.filter.update (:require [metabase.lib.breakout :as lib.breakout] [metabase.lib.equality :as lib.equality] [metabase.lib.filter :as lib.filter] [metabase.lib.ref :as lib.ref] [metabase.lib.remove-replace :as lib.remove-replace] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.literal :as lib.schema.literal] [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.lib.schema.temporal-bucketing :as lib.schema.temporal-bucketing] [metabase.lib.temporal-bucket :as lib.temporal-bucket] [metabase.lib.util :as lib.util] [metabase.shared.util.time :as shared.ut] [metabase.util.malli :as mu] [metabase.util.malli.registry :as mr])) |
(defn- is-ref-for-column? [expr column]
(and (lib.util/clause-of-type? expr :field)
(lib.equality/find-matching-column expr [column]))) | |
(mu/defn ^:private remove-existing-filters-against-column :- ::lib.schema/query
"Remove any existing filters clauses that use `column` as the first arg in a stage of a `query`."
[query :- ::lib.schema/query
stage-number :- :int
column :- ::lib.schema.metadata/column]
(reduce
(fn [query [_tag _opts expr :as filter-clause]]
(if (is-ref-for-column? expr column)
(lib.remove-replace/remove-clause query stage-number filter-clause)
query))
query
(lib.filter/filters query stage-number))) | |
(mu/defn update-numeric-filter :- ::lib.schema/query
"Add or update a filter against `numeric-column`. Adapted from
https://github.com/metabase/metabase/blob/98bcd7fc3102bd7c07e8b68878c3738f3cb8727b/frontend/src/metabase-lib/queries/utils/actions.js#L151-L154"
([query numeric-column start end]
(update-numeric-filter query -1 numeric-column start end))
([query :- ::lib.schema/query
stage-number :- :int
numeric-column :- ::lib.schema.metadata/column
start :- number?
end :- number?]
(let [[start end] (sort [start end])]
(-> query
(remove-existing-filters-against-column stage-number numeric-column)
(lib.filter/filter stage-number (lib.filter/between numeric-column start end)))))) | |
Minimum number of points an updated query should return; if it will return less than this, switch to
the [[unit->next-unit]]. E.g. if we zoom in on a query using unit is points in this case correspond to the number of rows returned by a query if there are no gaps. E.g. if we have a query like orders, count aggregation, broken out by month(created_at) between 2024-01 and 2024-03 (inclusive) we would have at most 3 rows returned -- the value for 2024-01, the value for 2024-02, and the value for 2024-03. If no rows have a created_at in that month, then those rows may not get returned. However, the FE should interpolate the missing values and still include points with values of zero; that's what we mean when we say "points" below. | (def ^:private temporal-filter-min-num-points 4) |
E.g. the next unit after | (def ^:private unit->next-unit
(let [units [:minute :hour :day :week :month :quarter :year]]
(zipmap units (cons nil units)))) |
(mu/defn ^:private temporal-filter-find-best-breakout-unit :- ::lib.schema.temporal-bucketing/unit.date-time.truncate
"If the current breakout `unit` will not return at least [[temporal-filter-min-num-points]], find the largest unit
that will."
[unit :- ::lib.schema.temporal-bucketing/unit.date-time.truncate
start :- ::lib.schema.literal/temporal
end :- ::lib.schema.literal/temporal]
(loop [unit unit]
(let [num-points (shared.ut/unit-diff unit start end)
too-few-points? (< num-points temporal-filter-min-num-points)]
(if-let [next-largest-unit (when too-few-points?
(unit->next-unit unit))]
(recur next-largest-unit)
unit)))) | |
(mu/defn ^:private temporal-filter-update-breakouts :- ::lib.schema/query
"Update the first breakout against `column` so it uses `new-unit` rather than the original unit (if any); remove all
other breakouts against that column."
[query :- ::lib.schema/query
stage-number :- :int
column :- ::lib.schema.metadata/column
new-unit :- ::lib.schema.temporal-bucketing/unit.date-time.truncate]
(transduce
identity
(fn
([{:keys [query]}]
query)
([{:keys [query has-seen-column?], :as m} breakout]
(if (is-ref-for-column? breakout column)
(let [query' (if has-seen-column?
;; already seen a breakout for this column: remove other breakouts.
(lib.remove-replace/remove-clause query stage-number breakout)
;; this is the first breakout we've seen for this column: replace it with one that uses
;; `new-unit`.
(let [col-ref (lib.ref/ref (lib.temporal-bucket/with-temporal-bucket column new-unit))]
(lib.remove-replace/replace-clause query stage-number breakout col-ref)))]
{:query query', :has-seen-column? true})
;; not a breakout against `column`: ignore it
m)))
{:query query, :has-seen-column? false}
(lib.breakout/breakouts query stage-number))) | |
just for [[update-temporal-filter]], we will also support plain JavaScript | (mr/def ::temporal-literal
#?(:clj
::lib.schema.literal/temporal
:cljs
[:or
::lib.schema.literal/temporal
[:fn
{:error/message "Instance of a JS Date"}
#(instance? js/Date %)]])) |
(mu/defn update-temporal-filter :- ::lib.schema/query
"Add or update a filter against `temporal-column`. Modify the temporal unit for any breakouts. For use powering the
brush zoom-in in timeseries visualizations.
This is adapted from old MLv1 code here
https://github.com/metabase/metabase/blob/98bcd7fc3102bd7c07e8b68878c3738f3cb8727b/frontend/src/metabase-lib/queries/utils/actions.js#L75-L132"
([query temporal-column start end]
(update-temporal-filter query -1 temporal-column start end))
([query :- ::lib.schema/query
stage-number :- :int
temporal-column :- ::lib.schema.metadata/column
start :- ::temporal-literal
end :- ::temporal-literal]
(let [query (remove-existing-filters-against-column query stage-number temporal-column)
unit (lib.temporal-bucket/raw-temporal-bucket temporal-column)
;; convert start and end to plain strings if they are JavaScript Date instances. The truncation stuff will
;; work better because the ISO-8601 Strings let us differentiate between Dates/DateTimes/Times better than
;; raw Date does. Also, the FE won't have to worry about converting it later
maybe-string #?(:clj identity
:cljs (fn [t]
(cond-> t
(not (string? t))
(shared.ut/format-for-base-type ((some-fn :effective-type :base-type) temporal-column)))))
start (maybe-string start)
end (maybe-string end)]
(if-not unit
;; Temporal column is not bucketed: we don't need to update any temporal units here. Add/update a `:between`
;; filter.
(lib.filter/filter query stage-number (lib.filter/between temporal-column start end))
;; temporal-column IS bucketed: need to update the breakout(s) against this column.
(let [;; clamp range to unit to ensure we select exactly what's represented by the dots/bars. E.g. if I draw my
;; filter from `2024-01-02` to `2024-03-05` and the unit is `:month`, we should only show the months
;; between those two values, i.e. only `2024-02` and `2024-03`.
start (shared.ut/truncate (shared.ut/add start unit 1) unit)
end (shared.ut/truncate end unit)
;; update the breakout unit if appropriate.
breakout-unit (temporal-filter-find-best-breakout-unit unit start end)
query (if (= unit breakout-unit)
query
(temporal-filter-update-breakouts query stage-number temporal-column breakout-unit))]
(if (= (str start) (str end))
;; is the start and end are the same (in whatever the original unit was) then just do an "="
(lib.filter/filter query stage-number (lib.filter/= temporal-column start))
;; otherwise do a between (which is inclusive)
(lib.filter/filter query stage-number (lib.filter/between temporal-column start end)))))))) | |
(mr/def ::lat-lon.bounds [:map [:north number?] [:east number?] [:south number?] [:west number?]]) | |
(mu/defn update-lat-lon-filter :- ::lib.schema/query
"For use powering the brush zoom-in behavior in map visualizations. Adapted from
https://github.com/metabase/metabase/blob/98bcd7fc3102bd7c07e8b68878c3738f3cb8727b/frontend/src/metabase-lib/queries/utils/actions.js#L134-L149"
([query latitude-column longitude-column bounds]
(update-lat-lon-filter query -1 latitude-column longitude-column bounds))
([query :- ::lib.schema/query
stage-number :- :int
latitude-column :- ::lib.schema.metadata/column
longitude-column :- :some
{:keys [north east south west], :as _bounds} :- [:ref ::lat-lon.bounds]]
(-> query
(remove-existing-filters-against-column stage-number latitude-column)
(remove-existing-filters-against-column stage-number longitude-column)
(lib.filter/filter stage-number (let [[lat-min lat-max] (sort [north south])
[lon-min lon-max] (sort [east west])]
(lib.filter/inside latitude-column longitude-column lat-max lon-min lat-min lon-max)))))) | |
(ns metabase.lib.hierarchy (:refer-clojure :exclude [derive isa?])) | |
Keyword hierarchy for MLv2 stuff. | (defonce hierarchy (atom (make-hierarchy))) |
Like [[clojure.core/derive]], but affects [[hierarchy]] rather than the global hierarchy. | (defn derive [tag parent] (swap! hierarchy clojure.core/derive tag parent) ;; for REPL convenience so we don't dump a lot of garbage nil) |
Like [[clojure.core/isa?]], but uses [[hierarchy]]. | (defn isa? [tag parent] (clojure.core/isa? @hierarchy tag parent)) |
Functions related to manipulating EXPLICIT joins in MBQL. | (ns metabase.lib.join (:require [clojure.string :as str] [inflections.core :as inflections] [medley.core :as m] [metabase.lib.card :as lib.card] [metabase.lib.common :as lib.common] [metabase.lib.dispatch :as lib.dispatch] [metabase.lib.equality :as lib.equality] [metabase.lib.filter :as lib.filter] [metabase.lib.filter.operator :as lib.filter.operator] [metabase.lib.hierarchy :as lib.hierarchy] [metabase.lib.join.util :as lib.join.util] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.options :as lib.options] [metabase.lib.query :as lib.query] [metabase.lib.ref :as lib.ref] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.expression :as lib.schema.expression] [metabase.lib.schema.filter :as lib.schema.filter] [metabase.lib.schema.join :as lib.schema.join] [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.lib.schema.temporal-bucketing :as lib.schema.temporal-bucketing] [metabase.lib.temporal-bucket :as lib.temporal-bucket] [metabase.lib.types.isa :as lib.types.isa] [metabase.lib.util :as lib.util] [metabase.mbql.util.match :as mbql.u.match] [metabase.shared.util.i18n :as i18n] [metabase.util :as u] [metabase.util.log :as log] [metabase.util.malli :as mu])) |
(defn- join? [x] (= (lib.dispatch/dispatch-value x) :mbql/join)) | |
(def ^:private Joinable [:or lib.metadata/TableMetadata lib.metadata/CardMetadata]) | |
(def ^:private JoinOrJoinable [:or [:ref ::lib.schema.join/join] Joinable]) | |
(declare with-join-alias) | |
Impl for [[with-join-alias]] for a join: recursively update the | (defn- with-join-alias-update-join-fields
[join new-alias]
(cond-> join
(:fields join) (update :fields (fn [fields]
(if-not (sequential? fields)
fields
(mapv (fn [field-ref]
(with-join-alias field-ref new-alias))
fields)))))) |
(mu/defn ^:private standard-join-condition? :- :boolean
"Whether this join condition is a binary condition with two `:field` references (a LHS and a RHS), as you'd produce
in the frontend using functions like [[join-condition-operators]], [[join-condition-lhs-columns]],
and [[join-condition-rhs-columns]]."
[condition :- [:maybe ::lib.schema.expression/boolean]]
(when condition
(mbql.u.match/match-one condition
[(_operator :guard keyword?)
_opts
[:field _lhs-opts _lhs-id-or-name]
[:field _rhs-opts _rhs-id-or-name]]
true
_
false))) | |
If | (defn- standard-join-condition-lhs
[condition]
(when (standard-join-condition? condition)
(let [[_operator _opts lhs _rhs] condition]
lhs))) |
If | (defn- standard-join-condition-rhs
[condition]
(when (standard-join-condition? condition)
(let [[_operator _opts _lhs rhs] condition]
rhs))) |
If (apply f rhs args) | (defn- standard-join-condition-update-rhs
[condition f & args]
(if-not (standard-join-condition? condition)
condition
(let [[operator opts lhs rhs] condition]
[operator opts lhs (apply f rhs args)]))) |
(mu/defn ^:private with-join-alias-update-join-conditions :- lib.join.util/PartialJoin
"Impl for [[with-join-alias]] for a join: recursively update the `:join-alias` for inside the `:conditions` of the
join.
If `old-alias` is specified, uses [[metabase.mbql.util.match]] to update all the `:field` references using the old
alias.
If `old-alias` is `nil`, updates the RHS of all 'standard' conditions (binary filter clauses with two `:field` refs as
args, e.g. the kind you'd get if you were using [[join-condition-operators]] and the like to create them). This
currently doesn't handle more complex filter clauses that were created without the 'normal' MLv2 functions used by
the frontend; we can add this in the future if we need it."
[join :- lib.join.util/PartialJoin
old-alias :- [:maybe ::lib.schema.common/non-blank-string]
new-alias :- [:maybe ::lib.schema.common/non-blank-string]]
(cond
(empty? (:conditions join))
join
;; if we've specified `old-alias`, then update ANY `:field` clause using it to `new-alias` instead.
old-alias
(mbql.u.match/replace-in join [:conditions]
[:field {:join-alias old-alias} _id-or-name]
(with-join-alias &match new-alias))
;; otherwise if `old-alias` is `nil`, then add (or remove!) `new-alias` to the RHS of any binary
;; filter clauses that don't already have a `:join-alias`.
:else
(update join :conditions (fn [conditions]
(mapv (fn [condition]
(standard-join-condition-update-rhs condition with-join-alias new-alias))
conditions))))) | |
Impl for [[with-join-alias]] for a join. | (defn- with-join-alias-update-join
[join new-alias]
(let [old-alias (lib.join.util/current-join-alias join)]
(-> join
(u/assoc-dissoc :alias new-alias)
(with-join-alias-update-join-fields new-alias)
(with-join-alias-update-join-conditions old-alias new-alias)))) |
(mu/defn with-join-alias :- lib.join.util/FieldOrPartialJoin
"Add OR REMOVE a specific `join-alias` to `field-or-join`, which is either a `:field`/Field metadata, or a join map.
Does not recursively update other references (yet; we can add this in the future)."
{:style/indent [:form]}
[field-or-join :- lib.join.util/FieldOrPartialJoin
join-alias :- [:maybe ::lib.schema.common/non-blank-string]]
(case (lib.dispatch/dispatch-value field-or-join)
:field
(lib.options/update-options field-or-join u/assoc-dissoc :join-alias join-alias)
:metadata/column
(u/assoc-dissoc field-or-join ::join-alias join-alias)
:mbql/join
(with-join-alias-update-join field-or-join join-alias)
;; this should not happen (and cannot happen in CLJ land)
;; but it does seem to happen in JS land with broken MLv1 queries
(do (log/error "with-join-value should not be called with" (pr-str field-or-join))
field-or-join))) | |
(mu/defn resolve-join :- ::lib.schema.join/join
"Resolve a join with a specific `join-alias`."
[query :- ::lib.schema/query
stage-number :- :int
join-alias :- ::lib.schema.common/non-blank-string]
(let [{:keys [joins]} (lib.util/query-stage query stage-number)]
(or (m/find-first #(= (:alias %) join-alias)
joins)
(throw (ex-info (i18n/tru "No join named {0}, found: {1}"
(pr-str join-alias)
(pr-str (mapv :alias joins)))
{:join-alias join-alias
:query query
:stage-number stage-number}))))) | |
(defmethod lib.metadata.calculation/display-name-method :mbql/join
[query _stage-number {[{:keys [source-table source-card], :as _first-stage}] :stages, :as _join} _style]
(or
(when source-table
(:display-name (lib.metadata/table query source-table)))
(when source-card
(if-let [card-metadata (lib.metadata/card query source-card)]
(lib.metadata.calculation/display-name query 0 card-metadata)
(lib.card/fallback-display-name source-card)))
(i18n/tru "Native Query"))) | |
(defmethod lib.metadata.calculation/display-info-method :mbql/join
[query stage-number join]
(let [display-name (lib.metadata.calculation/display-name query stage-number join)]
{:name (or (:alias join) display-name), :display-name display-name})) | |
(defmethod lib.metadata.calculation/metadata-method :mbql/join
[_query _stage-number _query]
;; not i18n'ed because this shouldn't be developer-facing.
(throw (ex-info "You can't calculate a metadata map for a join! Use lib.metadata.calculation/returned-columns-method instead."
{}))) | |
(mu/defn ^:private column-from-join-fields :- lib.metadata.calculation/ColumnMetadataWithSource
"For a column that comes from a join `:fields` list, add or update metadata as needed, e.g. include join name in the
display name."
[query :- ::lib.schema/query
stage-number :- :int
column-metadata :- ::lib.schema.metadata/column
join-alias :- ::lib.schema.common/non-blank-string]
(let [column-metadata (assoc column-metadata :source-alias join-alias)
col (-> (assoc column-metadata
:display-name (lib.metadata.calculation/display-name query stage-number column-metadata)
:lib/source :source/joins)
(with-join-alias join-alias))]
(assert (= (lib.join.util/current-join-alias col) join-alias))
col)) | |
(defmethod lib.metadata.calculation/display-name-method :option/join.strategy
[_query _stage-number {:keys [strategy]} _style]
(case strategy
:left-join (i18n/tru "Left outer join")
:right-join (i18n/tru "Right outer join")
:inner-join (i18n/tru "Inner join")
:full-join (i18n/tru "Full outer join"))) | |
(defmethod lib.metadata.calculation/display-info-method :option/join.strategy
[query stage-number {:keys [strategy default], :as option}]
(cond-> {:short-name (u/qualified-name strategy)
:display-name (lib.metadata.calculation/display-name query stage-number option)}
default (assoc :default true))) | |
(mu/defn ^:private add-source-and-desired-aliases :- :map
[join :- [:map
[:alias
{:error/message "Join must have an alias to determine column aliases!"}
::lib.schema.common/non-blank-string]]
unique-name-fn :- fn?
col :- :map]
(assoc col
:lib/source-column-alias ((some-fn :lib/source-column-alias :name) col)
:lib/desired-column-alias (unique-name-fn (lib.join.util/joined-field-desired-alias
(:alias join)
((some-fn :lib/source-column-alias :name) col))))) | |
(defmethod lib.metadata.calculation/returned-columns-method :mbql/join
[query
stage-number
{:keys [fields stages], join-alias :alias, :or {fields :none}, :as join}
{:keys [unique-name-fn], :as options}]
(when-not (= fields :none)
(let [ensure-previous-stages-have-metadata (resolve 'metabase.lib.stage/ensure-previous-stages-have-metadata)
join-query (cond-> (assoc query :stages stages)
ensure-previous-stages-have-metadata
(ensure-previous-stages-have-metadata -1))
field-metadatas (if (= fields :all)
(lib.metadata.calculation/returned-columns join-query -1 (peek stages) options)
(for [field-ref fields
:let [join-field (lib.options/update-options field-ref dissoc :join-alias)]]
(lib.metadata.calculation/metadata join-query -1 join-field)))]
(mapv (fn [field-metadata]
(->> (column-from-join-fields query stage-number field-metadata join-alias)
(add-source-and-desired-aliases join unique-name-fn)))
field-metadatas)))) | |
(defmethod lib.metadata.calculation/visible-columns-method :mbql/join [query stage-number join options] (lib.metadata.calculation/returned-columns query stage-number (assoc join :fields :all) options)) | |
(mu/defn all-joins-visible-columns :- lib.metadata.calculation/ColumnsWithUniqueAliases
"Convenience for calling [[lib.metadata.calculation/visible-columns]] on all of the joins in a query stage."
[query :- ::lib.schema/query
stage-number :- :int
unique-name-fn :- fn?]
(into []
(mapcat (fn [join]
(lib.metadata.calculation/visible-columns query
stage-number
join
{:unique-name-fn unique-name-fn
:include-implicitly-joinable? false})))
(:joins (lib.util/query-stage query stage-number)))) | |
(mu/defn all-joins-expected-columns :- lib.metadata.calculation/ColumnsWithUniqueAliases
"Convenience for calling [[lib.metadata.calculation/returned-columns-method]] on all the joins in a query stage."
[query :- ::lib.schema/query
stage-number :- :int
options :- lib.metadata.calculation/ReturnedColumnsOptions]
(into []
(mapcat (fn [join]
(lib.metadata.calculation/returned-columns query stage-number join options)))
(:joins (lib.util/query-stage query stage-number)))) | |
Convert something to a join clause. | (defmulti ^:private join-clause-method
{:arglists '([joinable])}
lib.dispatch/dispatch-value
:hierarchy lib.hierarchy/hierarchy) |
TODO -- should the default implementation call [[metabase.lib.query/query]]? That way if we implement a method to
create an MBQL query from a | |
(defmethod join-clause-method :mbql/join [a-join-clause] a-join-clause) | |
TODO -- this probably ought to live in [[metabase.lib.query]] | (defmethod join-clause-method :mbql/query
[another-query]
(-> {:lib/type :mbql/join
:stages (:stages (lib.util/pipeline another-query))}
lib.options/ensure-uuid)) |
TODO -- this probably ought to live in [[metabase.lib.stage]] | (defmethod join-clause-method :mbql.stage/mbql
[mbql-stage]
(-> {:lib/type :mbql/join
:stages [mbql-stage]}
lib.options/ensure-uuid)) |
(defmethod join-clause-method :metadata/card
[card]
(-> {:lib/type :mbql/join
:stages [{:source-card (:id card)
:lib/type :mbql.stage/mbql}]}
lib.options/ensure-uuid)) | |
(declare with-join-fields) | |
(defmethod join-clause-method :metadata/table
[{::keys [join-alias join-fields], :as table-metadata}]
(cond-> (join-clause-method {:lib/type :mbql.stage/mbql
:lib/options {:lib/uuid (str (random-uuid))}
:source-table (:id table-metadata)})
join-alias (with-join-alias join-alias)
join-fields (with-join-fields join-fields))) | |
Add | (defn- with-join-conditions-add-alias-to-rhses
[conditions join-alias]
(if-not join-alias
conditions
(mapv (fn [condition]
(or (when-let [rhs (standard-join-condition-rhs condition)]
(when-not (lib.join.util/current-join-alias rhs)
(standard-join-condition-update-rhs condition with-join-alias join-alias)))
condition))
conditions))) |
(mu/defn with-join-conditions :- lib.join.util/PartialJoin
"Update the `:conditions` (filters) for a Join clause."
{:style/indent [:form]}
[a-join :- lib.join.util/PartialJoin
conditions :- [:maybe [:sequential [:or ::lib.schema.expression/boolean ::lib.schema.common/external-op]]]]
(let [conditions (-> (mapv lib.common/->op-arg conditions)
(with-join-conditions-add-alias-to-rhses (lib.join.util/current-join-alias a-join)))]
(u/assoc-dissoc a-join :conditions (not-empty conditions)))) | |
(mu/defn join-clause :- lib.join.util/PartialJoin
"Create an MBQL join map from something that can conceptually be joined against. A `Table`? An MBQL or native query? A
Saved Question? You should be able to join anything, and this should return a sensible MBQL join map."
([joinable]
(-> (join-clause-method joinable)
(u/assoc-default :fields :all)))
([joinable conditions]
(-> (join-clause joinable)
(with-join-conditions conditions)))) | |
(mu/defn with-join-fields :- lib.join.util/PartialJoin
"Update a join (or a function that will return a join) to include `:fields`, either `:all`, `:none`, or a sequence of
references."
[joinable :- lib.join.util/PartialJoin
fields :- [:maybe [:or [:enum :all :none] [:sequential some?]]]]
(let [fields (cond
(keyword? fields) fields
(= fields []) :none
:else (not-empty
(into []
(comp (map lib.ref/ref)
(if-let [current-alias (lib.join.util/current-join-alias joinable)]
(map #(with-join-alias % current-alias))
identity))
fields)))]
(u/assoc-dissoc joinable :fields fields))) | |
(defn- select-home-column
[home-cols cond-fields]
(let [cond-home-cols (keep #(lib.equality/find-matching-column % home-cols) cond-fields)]
;; first choice: the leftmost FK or PK in the condition referring to a home column
(or (m/find-first (some-fn lib.types.isa/foreign-key? lib.types.isa/primary-key?) cond-home-cols)
;; otherwise the leftmost home column in the condition
(first cond-home-cols)
;; otherwise the first FK home column
(m/find-first lib.types.isa/foreign-key? home-cols)
;; otherwise the first PK home column
(m/find-first lib.types.isa/primary-key? home-cols)
;; otherwise the first home column
(first home-cols)))) | |
(defn- strip-id [s]
(when (string? s)
(str/trim (str/replace s #"(?i) id$" )))) | |
Checks if | (defn- similar-names?
[name0 name1]
(and (string? name0) (string? name1)
(let [plural1 (delay (inflections/plural name1))
plural0 (delay (inflections/plural name0))]
(or (= name0 name1)
(= name0 @plural1)
(= @plural0 name1)
(= @plural0 @plural1))))) |
(defn- calculate-join-alias [query joined home-col]
(let [joined-name (lib.metadata.calculation/display-name
(if (= (:lib/type joined) :mbql/query) joined query)
joined)
home-name (when home-col (strip-id (lib.metadata.calculation/display-name query home-col)))
similar (similar-names? joined-name home-name)
join-alias (or (and joined-name
home-name
(not (re-matches #"(?i)id" home-name))
(not similar)
(str joined-name " - " home-name))
joined-name
home-name
"source")]
join-alias)) | |
(defn- add-alias-to-join-refs [query stage-number form join-alias join-cols]
(mbql.u.match/replace form
(field :guard (fn [field-clause]
(and (lib.util/field-clause? field-clause)
(boolean (lib.equality/find-matching-column query stage-number field-clause join-cols)))))
(with-join-alias field join-alias))) | |
(defn- add-alias-to-condition
[query stage-number condition join-alias home-cols join-cols]
(let [condition (add-alias-to-join-refs query stage-number condition join-alias join-cols)]
;; Sometimes conditions have field references which cannot be unambigously
;; assigned to one of the sides. The following code tries to deal with
;; these cases, but only for conditions that look like the ones generated
;; generated by the FE. These have the form home-field op join-field,
;; so we break ties by looking at the poisition of the field reference.
(mbql.u.match/replace condition
[op op-opts (lhs :guard lib.util/field-clause?) (rhs :guard lib.util/field-clause?)]
(let [lhs-alias (lib.join.util/current-join-alias lhs)
rhs-alias (lib.join.util/current-join-alias rhs)]
(cond
;; no sides obviously belong to joined
(not (or lhs-alias rhs-alias))
(if (lib.equality/find-matching-column query stage-number rhs home-cols)
[op op-opts (with-join-alias lhs join-alias) rhs]
[op op-opts lhs (with-join-alias rhs join-alias)])
;; both sides seem to belong to joined assuming this resulted from
;; overly fuzzy matching, we remove the join alias from the LHS
;; unless the RHS seems to belong to home too while the LHS doesn't
(and (= lhs-alias join-alias) (= rhs-alias join-alias))
(let [bare-lhs (lib.options/update-options lhs dissoc :join-alias)
bare-rhs (lib.options/update-options rhs dissoc :join-alias)]
(if (and (nil? (lib.equality/find-matching-column query stage-number bare-lhs home-cols))
(lib.equality/find-matching-column query stage-number bare-rhs home-cols))
[op op-opts lhs bare-rhs]
[op op-opts bare-lhs rhs]))
;; we leave alone the condition otherwise
:else &match))))) | |
(defn- generate-unique-name [base-name taken-names]
(let [generator (lib.util/unique-name-generator)]
(run! generator taken-names)
(generator base-name))) | |
(mu/defn add-default-alias :- ::lib.schema.join/join
"Add a default generated `:alias` to a join clause that does not already have one."
[query :- ::lib.schema/query
stage-number :- :int
a-join :- lib.join.util/JoinWithOptionalAlias]
(if (contains? a-join :alias)
;; if the join clause comes with an alias, keep it and assume that the
;; condition fields have the right join-aliases too
a-join
(let [stage (lib.util/query-stage query stage-number)
home-cols (lib.metadata.calculation/visible-columns query stage-number stage)
cond-fields (mbql.u.match/match (:conditions a-join) :field)
home-col (select-home-column home-cols cond-fields)
join-alias (-> (calculate-join-alias query a-join home-col)
(generate-unique-name (keep :alias (:joins stage))))
join-cols (lib.metadata.calculation/returned-columns
(lib.query/query-with-stages query (:stages a-join)))]
(-> a-join
(update :conditions
(fn [conditions]
(mapv #(add-alias-to-condition query stage-number % join-alias home-cols join-cols)
conditions)))
(with-join-alias join-alias))))) | |
(declare join-conditions
joined-thing
suggested-join-conditions) | |
(mu/defn join :- ::lib.schema/query
"Add a join clause to a `query`."
([query a-join]
(join query -1 a-join))
([query :- ::lib.schema/query
stage-number :- :int
a-join :- [:or lib.join.util/PartialJoin Joinable]]
(let [a-join (join-clause a-join)
suggested-conditions (when (empty? (join-conditions a-join))
(suggested-join-conditions query stage-number (joined-thing query a-join)))
a-join (cond-> a-join
(seq suggested-conditions) (with-join-conditions suggested-conditions))
a-join (add-default-alias query stage-number a-join)]
(lib.util/update-query-stage query stage-number update :joins (fn [existing-joins]
(conj (vec existing-joins) a-join)))))) | |
(mu/defn joins :- [:maybe ::lib.schema.join/joins]
"Get all joins in a specific `stage` of a `query`. If `stage` is unspecified, returns joins in the final stage of the
query."
([query]
(joins query -1))
([query :- ::lib.schema/query
stage-number :- :int]
(not-empty (get (lib.util/query-stage query stage-number) :joins)))) | |
(mu/defn join-conditions :- [:maybe ::lib.schema.join/conditions] "Get all join conditions for the given join" [a-join :- lib.join.util/PartialJoin] (:conditions a-join)) | |
(mu/defn join-fields :- [:maybe ::lib.schema.join/fields] "Get all join conditions for the given join" [a-join :- lib.join.util/PartialJoin] (:fields a-join)) | |
(defn- raw-join-strategy->strategy-option [raw-strategy]
(merge
{:lib/type :option/join.strategy
:strategy raw-strategy}
(when (= raw-strategy :left-join)
{:default true}))) | |
(mu/defn raw-join-strategy :- ::lib.schema.join/strategy "Get the raw keyword strategy (type) of a given join, e.g. `:left-join` or `:right-join`. This is either the value of the optional `:strategy` key or the default, `:left-join`, if `:strategy` is not specified." [a-join :- lib.join.util/PartialJoin] (get a-join :strategy :left-join)) | |
(mu/defn join-strategy :- ::lib.schema.join/strategy.option "Get the strategy (type) of a given join, as a `:option/join.strategy` map. If `:stategy` is unspecified, returns the default, left join." [a-join :- lib.join.util/PartialJoin] (raw-join-strategy->strategy-option (raw-join-strategy a-join))) | |
(mu/defn with-join-strategy :- lib.join.util/PartialJoin
"Return a copy of `a-join` with its `:strategy` set to `strategy`."
[a-join :- lib.join.util/PartialJoin
strategy :- [:or ::lib.schema.join/strategy ::lib.schema.join/strategy.option]]
;; unwrap the strategy to a raw keyword if needed.
(assoc a-join :strategy (cond-> strategy
(= (lib.dispatch/dispatch-value strategy) :option/join.strategy)
:strategy))) | |
(mu/defn available-join-strategies :- [:sequential ::lib.schema.join/strategy.option]
"Get available join strategies for the current Database (based on the Database's
supported [[metabase.driver/driver-features]]) as raw keywords like `:left-join`."
([query]
(available-join-strategies query -1))
;; stage number is not currently used, but it is taken as a parameter for consistency with the rest of MLv2
([query :- ::lib.schema/query
_stage-number :- :int]
(let [database (lib.metadata/database query)
features (:features database)]
(into []
(comp (filter (partial contains? features))
(map raw-join-strategy->strategy-option))
[:left-join :right-join :inner-join :full-join])))) | |
(mu/defn joined-thing :- [:maybe Joinable]
"Return metadata about the origin of `a-join` using `metadata-providerable` as the source of information."
[metadata-providerable :- lib.metadata/MetadataProviderable
a-join :- lib.join.util/PartialJoin]
(let [origin (-> a-join :stages first)]
(cond
(:source-card origin) (lib.metadata/card metadata-providerable (:source-card origin))
(:source-table origin) (lib.metadata/table metadata-providerable (:source-table origin))))) | |
Building join conditions: The QB GUI needs to build a join condition before the join itself is attached to the query. There are three parts to a join condition. Suppose we're building a query like SELECT * FROM order JOIN user ON order.user_id = user.id The condition is order.user_id = user.id ^^^^^^^^^^^^^ ^ ^^^^^^^ 1 2 3 and the three parts are:
The Query Builder allows selecting any of these three parts in any order. The functions below return possible options for each respective part. At the time of this writing, selecting one does not filter out incompatible options for the other parts, but hopefully we can implement this in the future -- see #31174 | |
(mu/defn ^:private sort-join-condition-columns :- [:sequential ::lib.schema.metadata/column]
"Sort potential join condition columns as returned by [[join-condition-lhs-columns]]
or [[join-condition-rhs-columns]]. PK columns are returned first, followed by FK columns, followed by other columns.
Otherwise original order is maintained."
[columns :- [:sequential ::lib.schema.metadata/column]]
(let [{:keys [pk fk other]} (group-by (fn [column]
(cond
(lib.types.isa/primary-key? column) :pk
(lib.types.isa/foreign-key? column) :fk
:else :other))
columns)]
(concat pk fk other))) | |
(defn- mark-selected-column [query stage-number existing-column-or-nil columns]
(if-not existing-column-or-nil
columns
(mapv (fn [column]
(if (:selected? column)
(lib.temporal-bucket/with-temporal-bucket
column
(lib.temporal-bucket/temporal-bucket existing-column-or-nil))
column))
(lib.equality/mark-selected-columns query stage-number columns [existing-column-or-nil])))) | |
(mu/defn join-condition-lhs-columns :- [:sequential ::lib.schema.metadata/column]
"Get a sequence of columns that can be used as the left-hand-side (source column) in a join condition. This column
is the one that comes from the source Table/Card/previous stage of the query or a previous join.
If you are changing the LHS of a condition for an existing join, pass in that existing join as `join-or-joinable` so
we can filter out the columns added by it (it doesn't make sense to present the columns added by a join as options
for its own LHS) or added by later joins (joins can only depend on things from previous joins). Otherwise you can
either pass in `nil` or the [[Joinable]] (Table or Card metadata) we're joining against when building a new
join. (Things other than joins are ignored, but this argument is flexible for consistency with the signature
of [[join-condition-rhs-columns]].) See #32005 for more info.
If the left-hand-side column has already been chosen and we're UPDATING it, pass in `lhs-column-or-nil` so we can
mark the current column as `:selected` in the metadata/display info.
If the right-hand-side column has already been chosen (they can be chosen in any order in the Query Builder UI),
pass in the chosen RHS column. In the future, this may be used to restrict results to compatible columns. (See #31174)
Results will be returned in a 'somewhat smart' order with PKs and FKs returned before other columns.
Unlike most other things that return columns, implicitly-joinable columns ARE NOT returned here."
([query joinable lhs-column-or-nil rhs-column-or-nil]
(join-condition-lhs-columns query -1 joinable lhs-column-or-nil rhs-column-or-nil))
([query :- ::lib.schema/query
stage-number :- :int
join-or-joinable :- [:maybe JoinOrJoinable]
lhs-column-or-nil :- [:maybe lib.join.util/Field]
;; not yet used, hopefully we will use in the future when present for filtering incompatible columns out.
_rhs-column-or-nil :- [:maybe lib.join.util/Field]]
;; calculate all the visible columns including the existing join; then filter out any columns that come from the
;; existing join and any subsequent joins. The reason for doing things this way rather than removing the joins
;; before calculating visible columns is that we don't want to either create possibly-invalid queries, or have to
;; rely on the logic in [[metabase.lib.remove-replace/remove-join]] which would cause circular references; this is
;; simpler as well.
;;
;; e.g. if we have joins [J1 J2 J3 J4] and current join = J2, then we want to ignore the visible columns from J2,
;; J3, and J4.
(let [existing-join-alias (when (join? join-or-joinable)
(lib.join.util/current-join-alias join-or-joinable))
join-aliases-to-ignore (into #{}
(comp (map lib.join.util/current-join-alias)
(drop-while #(not= % existing-join-alias)))
(joins query stage-number))
lhs-column-or-nil (or lhs-column-or-nil
(when (join? join-or-joinable)
(standard-join-condition-lhs (first (join-conditions join-or-joinable)))))]
(->> (lib.metadata.calculation/visible-columns query stage-number
(lib.util/query-stage query stage-number)
{:include-implicitly-joinable? false})
(remove (fn [col]
(when-let [col-join-alias (lib.join.util/current-join-alias col)]
(contains? join-aliases-to-ignore col-join-alias))))
(mark-selected-column query stage-number lhs-column-or-nil)
sort-join-condition-columns)))) | |
(mu/defn join-condition-rhs-columns :- [:sequential ::lib.schema.metadata/column]
"Get a sequence of columns that can be used as the right-hand-side (target column) in a join condition. This column
is the one that belongs to the thing being joined, `join-or-joinable`, which can be something like a
Table ([[metabase.lib.metadata/TableMetadata]]), Saved Question/Model ([[metabase.lib.metadata/CardMetadata]]),
another query, etc. -- anything you can pass to [[join-clause]]. You can also pass in an existing join.
If the left-hand-side column has already been chosen (they can be chosen in any order in the Query Builder UI),
pass in the chosen LHS column. In the future, this may be used to restrict results to compatible columns. (See #31174)
If the right-hand-side column has already been chosen and we're UPDATING it, pass in `rhs-column-or-nil` so we can
mark the current column as `:selected` in the metadata/display info.
Results will be returned in a 'somewhat smart' order with PKs and FKs returned before other columns."
([query joinable lhs-column-or-nil rhs-column-or-nil]
(join-condition-rhs-columns query -1 joinable lhs-column-or-nil rhs-column-or-nil))
([query :- ::lib.schema/query
stage-number :- :int
join-or-joinable :- JoinOrJoinable
;; not yet used, hopefully we will use in the future when present for filtering incompatible columns out.
_lhs-column-or-nil :- [:maybe lib.join.util/Field]
rhs-column-or-nil :- [:maybe lib.join.util/Field]]
;; I was on the fence about whether these should get `:lib/source :source/joins` or not -- it seems like based on
;; the QB UI they shouldn't. See screenshots in #31174
(let [joinable (if (join? join-or-joinable)
(joined-thing query join-or-joinable)
join-or-joinable)
join-alias (when (join? join-or-joinable)
(lib.join.util/current-join-alias join-or-joinable))
rhs-column-or-nil (or rhs-column-or-nil
(when (join? join-or-joinable)
(standard-join-condition-rhs (first (join-conditions join-or-joinable)))))
rhs-column-or-nil (when rhs-column-or-nil
(cond-> rhs-column-or-nil
;; Drop the :join-alias from the RHS if the joinable doesn't have one either.
(not join-alias) (lib.options/update-options dissoc :join-alias)))]
(->> (lib.metadata.calculation/visible-columns query stage-number joinable {:include-implicitly-joinable? false})
(map (fn [col]
(cond-> (assoc col :lib/source :source/joins)
join-alias (with-join-alias join-alias))))
(mark-selected-column query stage-number rhs-column-or-nil)
sort-join-condition-columns)))) | |
(mu/defn join-condition-operators :- [:sequential ::lib.schema.filter/operator]
"Return a sequence of valid filter clause operators that can be used to build a join condition. In the Query Builder
UI, this can be chosen at any point before or after choosing the LHS and RHS. Invalid options are not currently
filtered out based on values of the LHS or RHS, but in the future we can add this -- see #31174."
([query lhs-column-or-nil rhs-column-or-nil]
(join-condition-operators query -1 lhs-column-or-nil rhs-column-or-nil))
([_query :- ::lib.schema/query
_stage-number :- :int
;; not yet used, hopefully we will use in the future when present for filtering incompatible options out.
_lhs-column-or-nil :- [:maybe ::lib.schema.metadata/column]
_rhs-column-or-nil :- [:maybe ::lib.schema.metadata/column]]
;; currently hardcoded to these six operators regardless of LHS and RHS.
lib.filter.operator/join-operators)) | |
(mu/defn ^:private fk-columns-to :- [:maybe [:sequential
{:min 1}
[:and
::lib.schema.metadata/column
[:map
[::target ::lib.schema.metadata/column]]]]]
"Find FK columns in `source` pointing at a column in `target`. Includes the target column under the `::target` key."
[query :- ::lib.schema/query
stage-number :- :int
source
target]
(let [target-columns (delay
(lib.metadata.calculation/visible-columns
query stage-number target
{:include-implicitly-joinable? false
:include-implicitly-joinable-for-source-card? false}))]
(not-empty
(into []
(keep (fn [{:keys [fk-target-field-id], :as col}]
(when (and (lib.types.isa/foreign-key? col)
fk-target-field-id)
(when-let [target-column (m/find-first (fn [target-column]
(= fk-target-field-id
(:id target-column)))
@target-columns)]
(assoc col ::target target-column)))))
(lib.metadata.calculation/visible-columns query stage-number source))))) | |
(mu/defn suggested-join-conditions :- [:maybe [:sequential {:min 1} ::lib.schema.expression/boolean]] ; i.e., a filter clause
"Return suggested default join conditions when constructing a join against `joinable`, e.g. a Table, Saved
Question, or another query. Suggested conditions will be returned if the source Table has a foreign key to the
primary key of the thing we're joining (see #31175 for more info); otherwise this will return `nil` if no default
conditions are suggested."
([query joinable]
(suggested-join-conditions query -1 joinable))
([query :- ::lib.schema/query
stage-number :- :int
joinable]
(let [stage (lib.util/query-stage query stage-number)]
(letfn [ ;; only keep one FK to each target column e.g. for
;;
;; messages (sender_id REFERENCES user(id), recipient_id REFERENCES user(id))
;;
;; we only want join on one or the other, not both, because that makes no sense. However with a composite
;; FK -> composite PK suggest multiple conditions. See #34184
(fks [source target]
(->> (fk-columns-to query stage-number source target)
(m/distinct-by #(-> % ::target :id))
not-empty))
(filter-clause [x y]
;; DO NOT force broken refs for fields that come from Cards (broken refs in this case means use Field
;; ID refs instead of nominal field literal refs), that will break things if a Card returns the same
;; Field more than once (there would be no way to disambiguate). See #34227 for more info
(let [x (dissoc x ::lib.card/force-broken-id-refs)
y (dissoc y ::lib.card/force-broken-id-refs)]
(lib.filter/filter-clause (lib.filter.operator/operator-def :=) x y)))]
(or
;; find cases where we have FK(s) pointing to joinable. Our column goes on the LHS.
(when-let [fks (fks stage joinable)]
(mapv (fn [fk]
(filter-clause fk (::target fk)))
fks))
;; find cases where the `joinable` has FK(s) pointing to us. Note our column is the target this time around --
;; keep in on the LHS.
(when-let [fks (fks joinable stage)]
(mapv (fn [fk]
(filter-clause (::target fk) fk))
fks))))))) | |
(defn- add-join-alias-to-joinable-columns [cols a-join]
(let [join-alias (lib.join.util/current-join-alias a-join)
unique-name-fn (lib.util/unique-name-generator)]
(mapv (fn [col]
(as-> col col
(with-join-alias col join-alias)
(add-source-and-desired-aliases a-join unique-name-fn col)))
cols))) | |
Mark the column metadatas in | (defn- mark-selected-joinable-columns
[cols a-join]
(let [j-fields (join-fields a-join)]
(case j-fields
:all (mapv #(assoc % :selected? true)
cols)
(:none nil) (mapv #(assoc % :selected? false)
cols)
(lib.equality/mark-selected-columns cols j-fields)))) |
(mu/defn joinable-columns :- [:sequential ::lib.schema.metadata/column]
"Return information about the fields that you can pass to [[with-join-fields]] when constructing a join against
something [[Joinable]] (i.e., a Table or Card) or manipulating an existing join. When passing in a join, currently
selected columns (those in the join's `:fields`) will include `:selected true` information."
[query :- ::lib.schema/query
stage-number :- :int
join-or-joinable :- JoinOrJoinable]
(let [a-join (when (join? join-or-joinable)
join-or-joinable)
source (if a-join
(joined-thing query join-or-joinable)
join-or-joinable)
cols (lib.metadata.calculation/returned-columns query stage-number source)]
(cond-> cols
a-join (add-join-alias-to-joinable-columns a-join)
a-join (mark-selected-joinable-columns a-join)))) | |
(defn- join-lhs-display-name-from-condition-lhs
[query stage-number join-or-joinable condition-lhs-column-or-nil]
(when-let [condition-lhs-column (or condition-lhs-column-or-nil
(when (join? join-or-joinable)
(standard-join-condition-lhs (first (join-conditions join-or-joinable)))))]
(let [display-info (lib.metadata.calculation/display-info query stage-number condition-lhs-column)]
(get-in display-info [:table :display-name])))) | |
Whether a If a join is passed, we need to check whether it's the first join in the first stage of a source-table query or not. New joins get appended after any existing ones, so it would be safe to assume that if there are any other joins in the current stage, this will not be the first join in the stage. | (defn- first-join?
[query stage-number join-or-joinable]
(let [existing-joins (joins query stage-number)]
(or
;; if there are no existing joins, then this will be the first join regardless of what is passed in.
(empty? existing-joins)
;; otherwise there ARE existing joins, so this is only the first join if it is the same thing as the first join
;; in `existing-joins`.
(when (join? join-or-joinable)
(= (:alias join-or-joinable)
(:alias (first existing-joins))))))) |
(defn- join-lhs-display-name-for-first-join-in-first-stage
[query stage-number join-or-joinable]
(when (and (zero? (lib.util/canonical-stage-index query stage-number)) ; first stage?
(first-join? query stage-number join-or-joinable) ; first join?
(lib.util/source-table-id query)) ; query ultimately uses source Table?
(let [table-id (lib.util/source-table-id query)
table (lib.metadata/table query table-id)]
;; I think `:default` display name style is okay here, there shouldn't be a difference between `:default` and
;; `:long` for a Table anyway
(lib.metadata.calculation/display-name query stage-number table)))) | |
(mu/defn join-lhs-display-name :- ::lib.schema.common/non-blank-string
"Get the display name for whatever we are joining. See #32015 and #32764 for screenshot examples.
The rules, copied from MLv1, are as follows:
1. If we have the LHS column for the first join condition, we should use display name for wherever it comes from. E.g.
if the join is
```
JOIN whatever ON orders.whatever_id = whatever.id
```
then we should display the join like this:
```
+--------+ +----------+ +-------------+ +----------+
| Orders | + | Whatever | on | Orders | = | Whatever |
| | | | | Whatever ID | | ID |
+--------+ +----------+ +-------------+ +----------+
```
1a. If `join-or-joinable` is a join, we can take the condition LHS column from the join itself, since a join will
always have a condition. This should only apply to [[standard-join-condition?]] conditions.
1b. When building a join, you can optionally pass in `condition-lhs-column-or-nil` yourself.
2. If the condition LHS column is unknown, and this is the first join in the first stage of a query, and the query
uses a `:source-table`, then use the display name for the source Table.
3. Otherwise use `Previous results`.
This function needs to be usable while we are in the process of constructing a join in the context of a given stage,
but also needs to work for rendering existing joins. Pass a join in for existing joins, or something [[Joinable]]
for ones we are currently building."
([query join-or-joinable]
(join-lhs-display-name query join-or-joinable nil))
([query join-or-joinable condition-lhs-column-or-nil]
(join-lhs-display-name query -1 join-or-joinable condition-lhs-column-or-nil))
([query :- ::lib.schema/query
stage-number :- :int
join-or-joinable :- [:maybe JoinOrJoinable]
condition-lhs-column-or-nil :- [:maybe [:or ::lib.schema.metadata/column :mbql.clause/field]]]
(or
(join-lhs-display-name-from-condition-lhs query stage-number join-or-joinable condition-lhs-column-or-nil)
(join-lhs-display-name-for-first-join-in-first-stage query stage-number join-or-joinable)
(i18n/tru "Previous results")))) | |
(mu/defn join-condition-update-temporal-bucketing :- ::lib.schema.expression/boolean
"Updates the provided join-condition's fields' temporal-bucketing option, returns the updated join-condition.
Must be called on a standard join condition as per [[standard-join-condition?]].
This will sync both the lhs and rhs fields, and the fields that support the provided option will be updated.
Fields that do not support the provided option will be ignored."
([query :- ::lib.schema/query
join-condition :- [:or ::lib.schema.expression/boolean ::lib.schema.common/external-op]
option-or-unit :- [:maybe [:or
::lib.schema.temporal-bucketing/option
::lib.schema.temporal-bucketing/unit]]]
(join-condition-update-temporal-bucketing query -1 join-condition option-or-unit))
([query :- ::lib.schema/query
stage-number :- :int
join-condition :- [:or ::lib.schema.expression/boolean ::lib.schema.common/external-op]
option-or-unit :- [:maybe [:or
::lib.schema.temporal-bucketing/option
::lib.schema.temporal-bucketing/unit]]]
(let [[_ _ lhs rhs :as join-condition] (lib.common/->op-arg join-condition)]
(assert (standard-join-condition? join-condition)
(i18n/tru "Non-standard join condition. {0}" (pr-str join-condition)))
(let [unit (cond-> option-or-unit
(not (keyword? option-or-unit)) :unit)
stage-number (lib.util/canonical-stage-index query stage-number)
available-lhs (lib.temporal-bucket/available-temporal-buckets query stage-number lhs)
available-rhs (lib.temporal-bucket/available-temporal-buckets query stage-number rhs)
sync-lhs? (or (nil? unit) (contains? (set (map :unit available-lhs)) unit))
sync-rhs? (or (nil? unit) (contains? (set (map :unit available-rhs)) unit))]
(cond-> join-condition
sync-lhs? (update 2 lib.temporal-bucket/with-temporal-bucket unit)
sync-rhs? (update 3 lib.temporal-bucket/with-temporal-bucket unit)))))) | |
(defmethod lib.metadata.calculation/describe-top-level-key-method :joins
[query stage-number _key]
(some->> (not-empty (joins query stage-number))
(map #(lib.metadata.calculation/display-name query stage-number %))
(str/join " + " ))) | |
Some small join-related helper functions which are used from a few different namespaces. | (ns metabase.lib.join.util (:require [metabase.lib.dispatch :as lib.dispatch] [metabase.lib.metadata :as lib.metadata] [metabase.lib.options :as lib.options] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.join :as lib.schema.join] [metabase.lib.util :as lib.util] [metabase.util.malli :as mu])) |
A Join that may not yet have an | (def JoinWithOptionalAlias
[:merge
[:ref ::lib.schema.join/join]
[:map
[:alias {:optional true} [:ref ::lib.schema.join/alias]]]]) |
A join that may not yet have an | (def PartialJoin
[:merge
JoinWithOptionalAlias
[:map
[:conditions {:optional true} [:ref ::lib.schema.join/conditions]]]]) |
A field in a join, either [[lib.metadata/ColumnMetadata]] or a | (def Field [:or lib.metadata/ColumnMetadata [:ref :mbql.clause/field]]) |
A field or a partial join. | (def FieldOrPartialJoin [:or Field PartialJoin]) |
(mu/defn current-join-alias :- [:maybe ::lib.schema.common/non-blank-string]
"Get the current join alias associated with something, if it has one."
[field-or-join :- [:maybe FieldOrPartialJoin]]
(case (lib.dispatch/dispatch-value field-or-join)
:dispatch-type/nil nil
:field (:join-alias (lib.options/options field-or-join))
:metadata/column (:metabase.lib.join/join-alias field-or-join)
:mbql/join (:alias field-or-join))) | |
(mu/defn joined-field-desired-alias :- ::lib.schema.common/non-blank-string
"Desired alias for a Field that comes from a join, e.g.
MyJoin__my_field
You should pass the results thru a unique name function."
[join-alias :- ::lib.schema.common/non-blank-string
field-name :- ::lib.schema.common/non-blank-string]
(lib.util/format "%s__%s" join-alias field-name)) | |
(mu/defn format-implicit-join-name :- ::lib.schema.common/non-blank-string
"Name for an implicit join against `table-name` via an FK field, e.g.
CATEGORIES__via__CATEGORY_ID
You should make sure this gets ran thru a unique-name fn."
[table-name :- ::lib.schema.common/non-blank-string
source-field-id-name :- ::lib.schema.common/non-blank-string]
(lib.util/format "%s__via__%s" table-name source-field-id-name)) | |
(defn- implicit-join-name [query {:keys [fk-field-id table-id], :as _field-metadata}]
(when (and fk-field-id table-id)
(when-let [table (lib.metadata/table-or-card query table-id)]
(let [table-name (:name table)
source-field-id-name (:name (lib.metadata/field query fk-field-id))]
(format-implicit-join-name table-name source-field-id-name))))) | |
(mu/defn desired-alias :- ::lib.schema.common/non-blank-string
"Desired alias for a Field e.g.
my_field
OR
MyJoin__my_field
You should pass the results thru a unique name function."
[query :- ::lib.schema/query
field-metadata :- lib.metadata/ColumnMetadata]
(if-let [join-alias (or (current-join-alias field-metadata)
(implicit-join-name query field-metadata))]
(joined-field-desired-alias join-alias (:name field-metadata))
(:name field-metadata))) | |
JavaScript-friendly interface to the entire Metabase lib? This stuff will probably change a bit as MLv2 evolves. Note that in JS we've made the decision to make the stage number always be required as an explicit parameter, so we
DO NOT need to expose the | (ns metabase.lib.js (:refer-clojure :exclude [filter]) (:require [clojure.string :as str] [clojure.walk :as walk] [goog.object :as gobject] [medley.core :as m] [metabase.lib.cache :as lib.cache] [metabase.lib.convert :as lib.convert] [metabase.lib.core :as lib.core] [metabase.lib.equality :as lib.equality] [metabase.lib.field :as lib.field] [metabase.lib.join :as lib.join] [metabase.lib.js.metadata :as js.metadata] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.metadata.protocols :as lib.metadata.protocols] [metabase.lib.order-by :as lib.order-by] [metabase.lib.stage :as lib.stage] [metabase.lib.types.isa :as lib.types.isa] [metabase.lib.util :as lib.util] [metabase.mbql.js :as mbql.js] [metabase.mbql.normalize :as mbql.normalize] [metabase.shared.util.time :as shared.ut] [metabase.util :as u] [metabase.util.log :as log] [metabase.util.memoize :as memoize])) |
this is mostly to ensure all the relevant namespaces with multimethods impls get loaded. | (comment lib.core/keep-me) |
(defn- remove-undefined-properties
[obj]
(cond-> obj
(object? obj) (gobject/filter (fn [e _ _] (not (undefined? e)))))) | |
(defn- convert-js-template-tags [tags]
(-> tags
(gobject/map (fn [e _ _]
(remove-undefined-properties e)))
js->clj
(update-vals #(-> %
(update-keys keyword)
(update :type keyword))))) | |
Extract the template tags from a native query's text. If the optional map of existing tags previously parsed is given, this will reuse the existing tags where they match up with the new one (in particular, it will preserve the UUIDs). Given the text of a native query, extract a possibly-empty set of template tag strings from it. These look like mustache templates. For variables, we only allow alphanumeric characters, eg. Invalid patterns are simply ignored, so something like | (defn ^:export extract-template-tags
([query-text] (extract-template-tags query-text {}))
([query-text existing-tags]
(->> (convert-js-template-tags existing-tags)
(lib.core/extract-template-tags query-text)
clj->js))) |
Return a nice description of a query. | (defn ^:export suggestedName [query] (lib.core/suggested-name query)) |
Convert metadata to a metadata provider if it is not one already. | (defn ^:export metadataProvider
[database-id metadata]
(if (lib.metadata.protocols/metadata-provider? metadata)
metadata
(js.metadata/metadata-provider database-id metadata))) |
Coerce a plain map | (defn ^:export query
([metadata-provider table-or-card-metadata]
(lib.core/query metadata-provider table-or-card-metadata))
([database-id metadata query-map]
(let [query-map (lib.convert/js-legacy-query->pMBQL query-map)]
(log/debugf "query map: %s" (pr-str query-map))
(lib.core/query (metadataProvider database-id metadata) query-map)))) |
This converts namespaced keywords to strings as
As an example of such a value, | (defn- fix-namespaced-values
[x]
(cond
(qualified-keyword? x) (str (namespace x) "/" (name x))
(map? x) (update-vals x fix-namespaced-values)
(sequential? x) (map fix-namespaced-values x)
:else x)) |
Coerce a CLJS pMBQL query back to (1) a legacy query (2) in vanilla JS. | (defn ^:export legacy-query [query-map] (-> query-map lib.convert/->legacy-MBQL fix-namespaced-values (clj->js :keyword-fn u/qualified-name))) |
Adds a new blank stage to the end of the pipeline | (defn ^:export append-stage [a-query] (lib.core/append-stage a-query)) |
Drops the final stage in the pipeline, will no-op if it is the only stage | (defn ^:export drop-stage [a-query] (lib.core/drop-stage a-query)) |
Drops the final stage in the pipeline IF the stage is empty of clauses, otherwise no-op | (defn ^:export drop-stage-if-empty [a-query] (lib.core/drop-stage-if-empty a-query)) |
Return a sequence of Column metadatas about the columns you can add order bys for in a given stage of | (defn ^:export orderable-columns
[a-query stage-number]
;; Attaches the cached columns directly to this query, in case it gets called again.
(lib.cache/side-channel-cache
(keyword "orderable-columns" (str "stage-" stage-number)) a-query
(fn [_]
(to-array (lib.order-by/orderable-columns a-query stage-number))))) |
Display-info ===================================================================================================== This is a complicated stack of caches and inner functions, so some guidance is in order. The outer surface is [[display-info*]] is the inner implementation. It calls [[lib.core/display-info]] to get the CLJS form, then [[display-info->js]] to convert it to JS. JS conversion in the tricky cases (maps and seqs) are handled by separate, LRU-cached functions [[display-info-map->js]] and [[display-info-seq->js]]. Keywords are converted with [[u/qualified-name]]. [[display-info-map->js]] converts CLJS maps to JS objects. Keys are converted from | |
[[display-info-seq->js]] converts CLJS | |
Note: there's an important property here that's worth calling out explicitly. It's possible for | (declare ^:private display-info->js) |
(defn- cljs-key->js-key [cljs-key]
(let [key-str (u/qualified-name cljs-key)
;; if the key is something like `many-pks?` convert it to something that is more JS-friendly (remove the
;; question mark), `:is-many-pks`, which becomes `isManyPks`
key-str (if (str/ends-with? key-str "?")
(str "is-" (str/replace key-str #"\?$" ))
key-str)]
(u/->camelCaseEn key-str))) | |
(defn- display-info-map->js* [x]
(reduce (fn [obj [cljs-key cljs-val]]
(let [js-key (cljs-key->js-key cljs-key)
js-val (display-info->js cljs-val)] ;; Recursing through the cache
(gobject/set obj js-key js-val)
obj))
#js {}
x)) | |
(def ^:private display-info-map->js (memoize/lru display-info-map->js* :lru/threshold 256)) | |
(defn- display-info-seq->js* [x] (to-array (map display-info->js x))) | |
(def ^:private display-info-seq->js (memoize/lru display-info-seq->js* :lru/threshold 256)) | |
Converts CLJS [[lib.core/display-info]] results into JS objects for the FE to consume.
Recursively converts CLJS maps and | (defn- display-info->js
[x]
(cond
;; Note that map? is only true for CLJS maps, not JS objects.
(map? x) (display-info-map->js x)
;; Likewise, JS arrays are not sequential? while CLJS vectors, seqs and sets are.
(sequential? x) (display-info-seq->js x)
(keyword? x) (u/qualified-name x)
:else x)) |
(defn- display-info* [a-query stage-number x]
(-> a-query
(lib.stage/ensure-previous-stages-have-metadata stage-number)
(lib.core/display-info stage-number x)
display-info->js)) | |
Given an opaque CLJS object, return a plain JS object with info you'd need to implement UI for it.
See | (defn ^:export display-info
;; See the big comment above about how `display-info` fits together.
[a-query stage-number x]
;; Attaches a cached display-info blob to `x`, in case it gets called again for the same object.
;; TODO: Keying by stage is probably unnecessary - if we eg. fetched a column from different stages, it would be a
;; different object. Test that idea and remove the stage from the cache key.
(lib.cache/side-channel-cache
(keyword "display-info-outer" (str "stage-" stage-number)) x
#(display-info* a-query stage-number %))) |
Create an order-by clause independently of a query, e.g. for | (defn ^:export order-by-clause ([orderable] (order-by-clause orderable :asc)) ([orderable direction] (lib.core/order-by-clause (lib.core/normalize (js->clj orderable :keywordize-keys true)) (keyword direction)))) |
Add an | (defn ^:export order-by [a-query stage-number orderable direction] (lib.core/order-by a-query stage-number orderable (keyword direction))) |
Get the order-by clauses (as an array of opaque objects) in | (defn ^:export order-bys [a-query stage-number] (to-array (lib.core/order-bys a-query stage-number))) |
Flip the direction of | (defn ^:export change-direction [a-query current-order-by] (lib.core/change-direction a-query current-order-by)) |
Return an array of Column metadatas about the columns that can be broken out by in a given stage of | (defn ^:export breakoutable-columns
[a-query stage-number]
;; Attaches the cached columns directly to this query, in case it gets called again.
(lib.cache/side-channel-cache
(keyword "breakoutable-columns" (str "stage-" stage-number)) a-query
(fn [_]
(to-array (lib.core/breakoutable-columns a-query stage-number))))) |
Get the breakout clauses (as an array of opaque objects) in | (defn ^:export breakouts [a-query stage-number] (to-array (lib.core/breakouts a-query stage-number))) |
Add an | (defn ^:export breakout [a-query stage-number x] (lib.core/breakout a-query stage-number (lib.core/ref x))) |
Returns the | (defn ^:export breakout-column [a-query stage-number breakout-clause] (lib.core/breakout-column a-query stage-number breakout-clause)) |
Retrieve the current binning state of a | (defn ^:export binning [x] (lib.core/binning x)) |
Given If
| (defn ^:export with-binning [x binning-option] (lib.core/with-binning x binning-option)) |
Get a list of available binning strategies for | (defn ^:export available-binning-strategies
([a-query x]
(-> (lib.core/available-binning-strategies a-query x)
to-array))
([a-query stage-number x]
(-> (lib.core/available-binning-strategies a-query stage-number x)
to-array))) |
Get the current temporal bucketing options associated with something, if any. | (defn ^:export temporal-bucket [x] (lib.core/temporal-bucket x)) |
Add a temporal bucketing option to an MBQL clause (or something that can be converted to an MBQL clause). | (defn ^:export with-temporal-bucket [x bucketing-option] (lib.core/with-temporal-bucket x bucketing-option)) |
Get a list of available temporal bucketing options for | (defn ^:export available-temporal-buckets
([a-query x]
(-> (lib.core/available-temporal-buckets a-query x)
to-array))
([a-query stage-number x]
(-> (lib.core/available-temporal-buckets a-query stage-number x)
to-array))) |
Removes the | (defn ^:export remove-clause [a-query stage-number clause] (lib.core/remove-clause a-query stage-number (lib.core/normalize (js->clj clause :keywordize-keys true)))) |
Replaces the | (defn ^:export replace-clause [a-query stage-number target-clause new-clause] (lib.core/replace-clause a-query stage-number (lib.core/normalize (js->clj target-clause :keywordize-keys true)) (lib.core/normalize (js->clj new-clause :keywordize-keys true)))) |
(defn- prep-query-for-equals [a-query field-ids]
(-> a-query
mbql.js/normalize-cljs
;; If `:native` exists, but it doesn't have `:template-tags`, add it.
(m/update-existing :native #(merge {:template-tags {}} %))
(m/update-existing :query (fn [inner-query]
(let [fields (or (:fields inner-query)
(for [id field-ids]
[:field id nil]))]
;; We ignore the order of the fields in the lists, but need to make sure any dupes
;; match up. Therefore de-dupe with `frequencies` rather than simply `set`.
(assoc inner-query :fields (frequencies fields))))))) | |
(defn- compare-legacy-field-refs
[[key1 id1 opts1]
[key2 id2 opts2]]
;; A mismatch of `:base-type` or `:effective-type` when both x and y have values for it is a failure.
;; If either ref does not have the `:base-type` or `:effective-type` set, that key is ignored.
(letfn [(clean-opts [o1 o2]
(not-empty
(cond-> o1
(not (:base-type o2)) (dissoc :base-type)
(not (:effective-type o2)) (dissoc :effective-type))))]
(= [key1 id1 (clean-opts opts1 opts2)]
[key2 id2 (clean-opts opts2 opts1)]))) | |
(defn- query=* [x y]
(cond
(and (vector? x)
(vector? y)
(= (first x) (first y) :field))
(compare-legacy-field-refs x y)
;; Otherwise this is a duplicate of clojure.core/=.
(and (map? x) (map? y))
(and (= (set (keys x)) (set (keys y)))
(every? (fn [[k v]]
(query=* v (get y k)))
x))
(and (sequential? x) (sequential? y))
(and (= (count x) (count y))
(every? true? (map query=* x y)))
;; Either mismatched map/sequence/nil/etc., or primitives like strings.
;; Either way, = does the right thing.
:else (= x y))) | |
Returns whether the provided queries should be considered equal. If Currently this works only for legacy queries in JS form!
It duplicates the logic formerly found in TODO: This should evolve into a more robust, pMBQL-based sense of equality over time.
For now it pulls logic that touches query internals into | (defn ^:export query=
([query1 query2] (query= query1 query2 nil))
([query1 query2 field-ids]
(let [n1 (prep-query-for-equals query1 field-ids)
n2 (prep-query-for-equals query2 field-ids)]
(query=* n1 n2)))) |
Given a group of columns returned by a function like [[metabase.lib.js/orderable-columns]], group the columns by Table or equivalent (e.g. Saved Question) so that they're in an appropriate shape for showing in the Query Builder. e.g a sequence of columns like [venues.id venues.name venues.category-id ;; implicitly joinable categories.id categories.name] would get grouped into groups like [{::columns [venues.id venues.name venues.category-id]} {::columns [categories.id categories.name]}] Groups have the type | (defn ^:export group-columns [column-metadatas] (to-array (lib.core/group-columns column-metadatas))) |
Get the columns associated with a column group | (defn ^:export columns-group-columns [column-group] (to-array (lib.core/columns-group-columns column-group))) |
Get a translated description of a temporal bucketing unit. | (defn ^:export describe-temporal-unit
[n unit]
(let [unit (if (string? unit) (keyword unit) unit)]
(lib.core/describe-temporal-unit n unit))) |
Get a translated description of a temporal bucketing interval. | (defn ^:export describe-temporal-interval
[n unit]
(let [n (if (string? n) (keyword n) n)
unit (if (string? unit) (keyword unit) unit)]
(lib.core/describe-temporal-interval n unit))) |
Get a translated description of a relative datetime interval. | (defn ^:export describe-relative-datetime
[n unit]
(let [n (if (string? n) (keyword n) n)
unit (if (string? unit) (keyword unit) unit)]
(lib.core/describe-relative-datetime n unit))) |
Adds an aggregation to query. | (defn ^:export aggregate [a-query stage-number an-aggregate-clause] (lib.core/aggregate a-query stage-number (js->clj an-aggregate-clause :keywordize-keys true))) |
Get the aggregations in a given stage of a query. | (defn ^:export aggregations [a-query stage-number] (to-array (lib.core/aggregations a-query stage-number))) |
Returns the | (defn ^:export aggregation-column [a-query stage-number aggregation-clause] (lib.core/aggregation-column a-query stage-number aggregation-clause)) |
Returns a standalone aggregation clause for an | (defn ^:export aggregation-clause ([aggregation-operator] (lib.core/aggregation-clause aggregation-operator)) ([aggregation-operator column] (lib.core/aggregation-clause aggregation-operator column))) |
Get the available aggregation operators for the stage with | (defn ^:export available-aggregation-operators [a-query stage-number] (to-array (lib.core/available-aggregation-operators a-query stage-number))) |
Get the columns | (defn ^:export aggregation-operator-columns [aggregation-operator] (to-array (lib.core/aggregation-operator-columns aggregation-operator))) |
Mark the operator and the column (if any) in | (defn ^:export selected-aggregation-operators [agg-operators agg-clause] (to-array (lib.core/selected-aggregation-operators (seq agg-operators) agg-clause))) |
Get the available filterable columns for the stage with | (defn ^:export filterable-columns
[a-query stage-number]
;; Attaches the cached columns directly to this query, in case it gets called again.
(lib.cache/side-channel-cache
(keyword "filterable-columns" (str "stage-" stage-number)) a-query
(fn [_]
(to-array (lib.core/filterable-columns a-query stage-number))))) |
Returns the operators for which | (defn ^:export filterable-column-operators [filterable-column] (to-array (lib.core/filterable-column-operators filterable-column))) |
Returns a standalone filter clause for a | (defn ^:export filter-clause [filter-operator column & args] (apply lib.core/filter-clause filter-operator column args)) |
Returns the filter operator of | (defn ^:export filter-operator [a-query stage-number a-filter-clause] (lib.core/filter-operator a-query stage-number a-filter-clause)) |
Returns a standalone clause for an | (defn ^:export expression-clause
[an-operator args options]
(-> (lib.core/expression-clause
(keyword an-operator)
args
(js->clj options :keywordize-keys true))
(lib.core/normalize))) |
Returns the parts (operator, args, and optionally, options) of | (defn ^:export expression-parts
[a-query stage-number an-expression-clause]
(let [parts (lib.core/expression-parts a-query stage-number an-expression-clause)]
(walk/postwalk
(fn [node]
(if (and (map? node) (= :mbql/expression-parts (:lib/type node)))
(let [{:keys [operator options args]} node]
#js {:operator (name operator)
:options (clj->js (select-keys options [:case-sensitive :include-current]))
:args (to-array (map #(if (keyword? %) (u/qualified-name %) %) args))})
node))
parts))) |
Returns true if arg is a a ColumnMetadata | (defn ^:export is-column-metadata [arg] (and (map? arg) (= :metadata/column (:lib/type arg)))) |
Sets | (defn ^:export filter [a-query stage-number boolean-expression] (lib.core/filter a-query stage-number (js->clj boolean-expression :keywordize-keys true))) |
Returns the current filters in stage with | (defn ^:export filters [a-query stage-number] (to-array (lib.core/filters a-query stage-number))) |
Return the filter clause in | (defn ^:export find-filter-for-legacy-filter
[a-query stage-number legacy-filter]
(->> (js->clj legacy-filter :keywordize-keys true)
(lib.core/find-filter-for-legacy-filter a-query stage-number))) |
Given a legacy | (defn ^:export find-filterable-column-for-legacy-ref [a-query stage-number a-legacy-ref] ;; [[lib.convert/legacy-ref->pMBQL]] will handle JS -> Clj conversion as needed (lib.core/find-filterable-column-for-legacy-ref a-query stage-number a-legacy-ref)) |
Get the current | (defn ^:export fields [a-query stage-number] (to-array (lib.core/fields a-query stage-number))) |
Specify the | (defn ^:export with-fields [a-query stage-number new-fields] (lib.core/with-fields a-query stage-number new-fields)) |
Return a sequence of column metadatas for columns that you can specify in the | (defn ^:export fieldable-columns
[a-query stage-number]
;; Attaches the cached columns directly to this query, in case it gets called again.
(lib.cache/side-channel-cache
(keyword "fieldable-columns" (str "stage-" stage-number)) a-query
(fn [_]
(to-array (lib.core/fieldable-columns a-query stage-number))))) |
Adds a given field ( | (defn ^:export add-field [a-query stage-number column] (lib.core/add-field a-query stage-number column)) |
Removes the field (a | (defn ^:export remove-field [a-query stage-number column] (lib.core/remove-field a-query stage-number column)) |
Given a sequence of | (defn ^:export find-column-for-legacy-ref [a-query stage-number a-legacy-ref columns] ;; [[lib.convert/legacy-ref->pMBQL]] will handle JS -> Clj conversion as needed (lib.core/find-column-for-legacy-ref a-query stage-number a-legacy-ref columns)) |
Inner implementation for [[visible-columns]], which wraps this with caching. | (defn- visible-columns*
[a-query stage-number]
(let [stage (lib.util/query-stage a-query stage-number)
vis-columns (lib.metadata.calculation/visible-columns a-query stage-number stage)
ret-columns (lib.metadata.calculation/returned-columns a-query stage-number stage)]
(to-array (lib.equality/mark-selected-columns a-query stage-number vis-columns ret-columns)))) |
Return a sequence of column metadatas for columns visible at the given stage of the query. Does not pass any options to [[visible-columns]], so it uses the defaults. TODO: Added as an expedient to fix metabase/metabase#32373. Due to the interaction with viz-settings, this issue was difficult to fix entirely within MLv2. Once viz-settings are ported, this function should not be needed, and the FE logic using it should be ported to MLv2 behind more meaningful names. | (defn ^:export visible-columns
[a-query stage-number]
;; Attaches the cached columns directly to this query, in case it gets called again.
(lib.cache/side-channel-cache
(keyword "visible-columns" (str "stage-" stage-number)) a-query
(fn [_]
(visible-columns* a-query stage-number)))) |
Inner implementation for [[returned-columns]], which wraps this with caching. | (defn- returned-columns*
[a-query stage-number]
(let [stage (lib.util/query-stage a-query stage-number)]
(->> (lib.metadata.calculation/returned-columns a-query stage-number stage)
(map #(assoc % :selected? true))
to-array))) |
Return a sequence of column metadatas for columns returned by the query. | (defn ^:export returned-columns
[a-query stage-number]
;; Attaches the cached columns directly to this query, in case it gets called again.
(lib.cache/side-channel-cache
(keyword "returned-columns" (str "stage-" stage-number)) a-query
(fn [_]
(returned-columns* a-query stage-number)))) |
(defn- normalize-legacy-ref
[a-ref]
(if (#{:metric :segment} (first a-ref))
(subvec a-ref 0 2)
(update a-ref 2 update-vals #(if (qualified-keyword? %)
(u/qualified-name %)
%)))) | |
Given a column, metric or segment metadata from eg. [[fieldable-columns]] or [[available-segments]], return it as a legacy JSON field ref. For compatibility reasons, segment and metric references are always returned without options. | (defn ^:export legacy-ref
[column]
(-> column
lib.core/ref
lib.convert/->legacy-MBQL
normalize-legacy-ref
clj->js)) |
(defn- legacy-ref->pMBQL [a-legacy-ref]
(-> a-legacy-ref
(js->clj :keywordize-keys true)
(update 0 keyword)
lib.convert/->pMBQL)) | |
(defn- ->column-or-ref [column]
(if-let [^js legacy-column (when (object? column) column)]
;; Convert legacy columns like we do for metadata.
(let [parsed (js.metadata/parse-column legacy-column)]
(if (= (:lib/source parsed) :source/aggregations)
;; Special case: Aggregations need to be converted to a pMBQL :aggregation ref and :lib/source-uuid set.
(let [agg-ref (legacy-ref->pMBQL (.-field_ref legacy-column))]
(assoc parsed :lib/source-uuid (last agg-ref)))
parsed))
;; It's already a :metadata/column map
column)) | |
Given a list of columns (either JS Returns a parallel list to the refs, with the corresponding index, or -1 if no matching column is found. | (defn ^:export find-column-indexes-from-legacy-refs
[a-query stage-number legacy-columns legacy-refs]
;; Set up this query stage's `:aggregation` list as the context for [[lib.convert/->pMBQL]] to convert legacy
;; `[:aggregation 0]` refs into pMBQL `[:aggregation uuid]` refs.
(lib.convert/with-aggregation-list (:aggregation (lib.util/query-stage a-query stage-number))
(let [haystack (mapv ->column-or-ref legacy-columns)
needles (map legacy-ref->pMBQL legacy-refs)]
#_{:clj-kondo/ignore [:discouraged-var]}
(to-array (lib.equality/find-column-indexes-for-refs a-query stage-number needles haystack))))) |
Returns the ID of the source table (as a number) or the ID of the source card (as a string prefixed
with "card__") of | (defn ^:export source-table-or-card-id
[a-query]
(or (lib.util/source-table-id a-query)
(some->> (lib.util/source-card-id a-query) (str "card__")))) |
Get the strategy (type) of a given join as an opaque JoinStrategy object. | (defn ^:export join-strategy [a-join] (lib.core/join-strategy a-join)) |
Return a copy of | (defn ^:export with-join-strategy [a-join strategy] (lib.core/with-join-strategy a-join strategy)) |
Get available join strategies for the current Database (based on the Database's supported [[metabase.driver/driver-features]]) as opaque JoinStrategy objects. | (defn ^:export available-join-strategies [a-query stage-number] (to-array (lib.core/available-join-strategies a-query stage-number))) |
Get a sequence of columns that can be used as the left-hand-side (source column) in a join condition. This column is the one that comes from the source Table/Card/previous stage of the query or a previous join. If you are changing the LHS of a condition for an existing join, pass in that existing join as If the left-hand-side column has already been chosen and we're UPDATING it, pass in If the right-hand-side column has already been chosen (they can be chosen in any order in the Query Builder UI), pass in the chosen RHS column. In the future, this may be used to restrict results to compatible columns. (See #31174) Results will be returned in a 'somewhat smart' order with PKs and FKs returned before other columns. Unlike most other things that return columns, implicitly-joinable columns ARE NOT returned here. | (defn ^:export join-condition-lhs-columns [a-query stage-number join-or-joinable lhs-column-or-nil rhs-column-or-nil] (to-array (lib.core/join-condition-lhs-columns a-query stage-number join-or-joinable lhs-column-or-nil rhs-column-or-nil))) |
Get a sequence of columns that can be used as the right-hand-side (target column) in a join condition. This column
is the one that belongs to the thing being joined, If the left-hand-side column has already been chosen (they can be chosen in any order in the Query Builder UI), pass in the chosen LHS column. In the future, this may be used to restrict results to compatible columns. (See #31174) If the right-hand-side column has already been chosen and we're UPDATING it, pass in Results will be returned in a 'somewhat smart' order with PKs and FKs returned before other columns. | (defn ^:export join-condition-rhs-columns [a-query stage-number join-or-joinable lhs-column-or-nil rhs-column-or-nil] (to-array (lib.core/join-condition-rhs-columns a-query stage-number join-or-joinable lhs-column-or-nil rhs-column-or-nil))) |
Return a sequence of valid filter clause operators that can be used to build a join condition. In the Query Builder UI, this can be chosen at any point before or after choosing the LHS and RHS. Invalid options are not currently filtered out based on values of the LHS or RHS, but in the future we can add this -- see #31174. | (defn ^:export join-condition-operators [a-query stage-number lhs-column-or-nil rhs-column-or-nil] (to-array (lib.core/join-condition-operators a-query stage-number lhs-column-or-nil rhs-column-or-nil))) |
Adds an expression to query. | (defn ^:export expression [a-query stage-number expression-name an-expression-clause] (lib.core/expression a-query stage-number expression-name an-expression-clause)) |
Return a new expression clause like | (defn ^:export with-expression-name [an-expression-clause new-name] (lib.core/with-expression-name an-expression-clause new-name)) |
Get the expressions map from a given stage of a | (defn ^:export expressions [a-query stage-number] (to-array (lib.core/expressions a-query stage-number))) |
Return an array of Column metadatas about the columns that can be used in an expression in a given stage of | (defn ^:export expressionable-columns
[a-query stage-number expression-position]
(lib.cache/side-channel-cache
;; Caching is based on both the stage and expression position, since they can return different sets.
;; TODO: Since these caches are mainly here to avoid expensively recomputing things in rapid succession, it would
;; probably suffice to cache only the last position, and evict if it's different. But the lib.cache system doesn't
;; support that currently.
(keyword "expressionable-columns" (str "stage-" stage-number "-" expression-position)) a-query
(fn [_]
(to-array (lib.core/expressionable-columns a-query stage-number expression-position))))) |
Return suggested default join conditions when constructing a join against | (defn ^:export suggested-join-conditions [a-query stage-number joinable] (to-array (lib.core/suggested-join-conditions a-query stage-number joinable))) |
Get the | (defn ^:export join-fields
[a-join]
(let [joined-fields (lib.core/join-fields a-join)]
(if (keyword? joined-fields)
(u/qualified-name joined-fields)
(to-array joined-fields)))) |
Set the | (defn ^:export with-join-fields
[a-join new-fields]
(lib.core/with-join-fields a-join (cond-> new-fields
(string? new-fields) keyword))) |
Create a join clause (an | (defn ^:export join-clause [joinable conditions] (lib.core/join-clause joinable conditions)) |
Add a join clause (as created by [[join-clause]]) to a stage of a query. | (defn ^:export join [a-query stage-number a-join] (lib.core/join a-query stage-number a-join)) |
Get the conditions (filter clauses) associated with a join. | (defn ^:export join-conditions [a-join] (to-array (lib.core/join-conditions a-join))) |
Set the | (defn ^:export with-join-conditions [a-join conditions] (lib.core/with-join-conditions a-join (js->clj conditions :keywordize-keys true))) |
Get the joins associated with a particular query stage. | (defn ^:export joins [a-query stage-number] (to-array (lib.core/joins a-query stage-number))) |
Rename the join specified by | (defn ^:export rename-join [a-query stage-number join-spec new-name] (lib.core/rename-join a-query stage-number join-spec new-name)) |
Remove the join specified by | (defn ^:export remove-join [a-query stage-number join-spec] (lib.core/remove-join a-query stage-number join-spec)) |
Return metadata about the origin of | (defn ^:export joined-thing [a-query a-join] (lib.join/joined-thing a-query a-join)) |
Temporary solution providing access to internal IDs for the FE to pass on to MLv1 functions. | (defn ^:export picker-info
[a-query metadata]
(case (:lib/type metadata)
:metadata/table #js {:databaseId (:database a-query)
:tableId (:id metadata)}
:metadata/card #js {:databaseId (:database a-query)
:tableId (str "card__" (:id metadata))
:cardId (:id metadata)
:isModel (:dataset metadata)}
(do
(log/warn "Cannot provide picker-info for" (:lib/type metadata))
nil))) |
Convert the internal operator | (defn ^:export external-op
[clause]
(let [{:keys [operator options args]} (lib.core/external-op clause)]
#js {:operator operator
:options (clj->js options)
:args (to-array args)})) |
Create a new native query. Native in this sense means a pMBQL query with a first stage that is a native query. | (defn ^:export native-query [database-id metadata inner-query] (lib.core/native-query (metadataProvider database-id metadata) inner-query)) |
Update the raw native query, the first stage must already be a native type. Replaces templates tags | (defn ^:export with-native-query [a-query inner-query] (lib.core/with-native-query a-query inner-query)) |
Updates the native query's template tags. | (defn ^:export with-template-tags [a-query tags] (lib.core/with-template-tags a-query (convert-js-template-tags tags))) |
Returns the native query string | (defn ^:export raw-native-query [a-query] (lib.core/raw-native-query a-query)) |
Returns the native query's template tags | (defn ^:export template-tags [a-query] (clj->js (lib.core/template-tags a-query))) |
Returns the extra keys that are required for this database's native queries, for example | (defn ^:export required-native-extras
[database-id metadata]
(to-array
(map u/qualified-name
(lib.core/required-native-extras (metadataProvider database-id metadata))))) |
Returns whether the database has native write permissions. This is only filled in by [[metabase.api.database/add-native-perms-info]] and added to metadata when pulling a database from the list of dbs in js. | (defn ^:export has-write-permission [a-query] (lib.core/has-write-permission a-query)) |
Changes the database for this query. The first stage must be a native type. Native extras must be provided if the new database requires it. | (defn ^:export with-different-database ([a-query database-id metadata] (with-different-database a-query database-id metadata nil)) ([a-query database-id metadata native-extras] (lib.core/with-different-database a-query (metadataProvider database-id metadata) (js->clj native-extras :keywordize-keys true)))) |
Updates the extras required for the db to run this query. The first stage must be a native type. Will ignore extras
not in | (defn ^:export with-native-extras [a-query native-extras] (lib.core/with-native-extras a-query (js->clj native-extras :keywordize-keys true))) |
Returns the extra keys for native queries associated with this query. | (defn ^:export native-extras [a-query] (clj->js (lib.core/native-extras a-query))) |
Returns the database engine. Must be a native query | (defn ^:export engine [a-query] (name (lib.core/engine a-query))) |
Get metadata for the Segment with | (defn ^:export segment-metadata [metadata-providerable segment-id] (lib.metadata/segment metadata-providerable segment-id)) |
Get a list of Segments that you may consider using as filters for a query. Returns JS array of opaque Segment metadata objects. | (defn ^:export available-segments [a-query stage-number] (to-array (lib.core/available-segments a-query stage-number))) |
Get metadata for the Metric with | (defn ^:export metric-metadata [metadata-providerable metric-id] (lib.metadata/metric metadata-providerable metric-id)) |
Get a list of Metrics that you may consider using as aggregations for a query. Returns JS array of opaque Metric metadata objects. | (defn ^:export available-metrics [a-query] (to-array (lib.core/available-metrics a-query))) |
Return information about the fields that you can pass to [[with-join-fields]] when constructing a join against
something [[Joinable]] (i.e., a Table or Card) or manipulating an existing join. When passing in a join, currently
selected columns (those in the join's | (defn ^:export joinable-columns [a-query stage-number join-or-joinable] ;; TODO: It's not practical to cache this currently. We need to be able to key off the query and the joinable, which ;; is not supported by the lib.cache system. (to-array (lib.core/joinable-columns a-query stage-number join-or-joinable))) |
Get TableMetadata if passed an integer | (defn ^:export table-or-card-metadata [query-or-metadata-provider table-id] (lib.metadata/table-or-card query-or-metadata-provider table-id)) |
Get the display name for whatever we are joining. For an existing join, pass in the join clause. When constructing a join, pass in the thing we are joining against, e.g. a TableMetadata or CardMetadata. | (defn ^:export join-lhs-display-name [a-query stage-number join-or-joinable condition-lhs-column-or-nil] (lib.core/join-lhs-display-name a-query stage-number join-or-joinable condition-lhs-column-or-nil)) |
Get the Database ID ( {:database -1337} we will attempt to resolve the correct Database ID by getting metadata for the source Card and returning its
| (defn ^:export database-id [a-query] (lib.core/database-id a-query)) |
Updates the provided join-condition's fields' temporal-bucketing option. Must be called on a standard join condition as per [[standard-join-condition?]]. This will sync both the lhs and rhs fields, and the fields that support the provided option will be updated. Fields that do not support the provided option will be ignored. | (defn ^:export join-condition-update-temporal-bucketing [a-query stage-number join-condition bucketing-option] (lib.core/join-condition-update-temporal-bucketing a-query stage-number join-condition bucketing-option)) |
(defn- fix-column-with-ref [a-ref column]
(cond-> column
;; Sometimes the FE has result metadata from the QP, without the required :lib/source-uuid on it.
;; We have the UUID for the aggregation in its ref, so use that here.
(some-> a-ref first (= :aggregation)) (assoc :lib/source-uuid (last a-ref)))) | |
Given a JS This properly handles fields, expressions and aggregations. | (defn ^:export legacy-column->metadata
[a-query stage-number ^js js-column]
(lib.convert/with-aggregation-list (lib.core/aggregations a-query stage-number)
(let [column-ref (when-let [a-ref (.-field_ref js-column)]
(legacy-ref->pMBQL a-ref))]
(fix-column-with-ref column-ref (js.metadata/parse-column js-column))))) |
Given a The spelling of the column key differs between multiple JS objects of this same general shape
( | (defn- js-cells-by
[col-fn]
(fn [^js cell]
(let [column (js.metadata/parse-column (col-fn cell))
column-ref (when-let [a-ref (:field-ref column)]
(legacy-ref->pMBQL a-ref))]
{:column (fix-column-with-ref column-ref column)
:column-ref column-ref
:value (.-value cell)}))) |
(def ^:private row-cell (js-cells-by #(.-col ^js %))) (def ^:private dimension-cell (js-cells-by #(.-column ^js %))) | |
Return an array (possibly empty) of drill-thrus given:
- Nullable column
- Nullable value
- Nullable data row (the array of Column can be nil for a "chart legend" click, eg. clicking a category in the legend explaining the colours in a multiple bar or line chart. Underlying records drills apply in that case! | (defn ^:export available-drill-thrus
[a-query stage-number column value row dimensions]
(lib.convert/with-aggregation-list (lib.core/aggregations a-query stage-number)
(let [column-ref (when-let [a-ref (and column (.-field_ref ^js column))]
(legacy-ref->pMBQL a-ref))]
(->> (merge {:column (when column
(fix-column-with-ref column-ref (js.metadata/parse-column column)))
:column-ref column-ref
:value (cond
(undefined? value) nil ; Missing a value, ie. a column click
(nil? value) :null ; Provided value is null, ie. database NULL
:else value)}
(when row {:row (mapv row-cell row)})
(when (not-empty dimensions) {:dimensions (mapv dimension-cell dimensions)}))
(lib.core/available-drill-thrus a-query stage-number)
to-array)))) |
Applies the given Each type of drill-thru has a different effect on the query. | (defn ^:export drill-thru [a-query stage-number a-drill-thru & args] (apply lib.core/drill-thru a-query stage-number a-drill-thru args)) |
Returns a JS object with opaque CLJS things in it, which are needed to render the complex UI for | (defn ^:export filter-drill-details
[{a-query :query
:keys [column stage-number value]
:as _filter-drill}]
#js {"column" column
"query" a-query
"stageIndex" stage-number
"value" (if (= value :null) nil value)}) |
Returns an array of pivot types that are available in this drill-thru, which must be a pivot drill-thru. | (defn ^:export pivot-types
[a-drill-thru]
(->> (lib.core/pivot-types a-drill-thru)
(map name)
to-array)) |
Returns an array of pivotable columns of the specified type. | (defn ^:export pivot-columns-for-type [a-drill-thru pivot-type] (to-array (lib.core/pivot-columns-for-type a-drill-thru (keyword pivot-type)))) |
Changes an existing query to use a different source table or card.
Can be passed an integer table id or a legacy | (defn ^:export with-different-table [a-query table-id] (lib.core/with-different-table a-query table-id)) |
Given a | (defn ^:export format-relative-date-range
[n unit offset-n offset-unit options]
(shared.ut/format-relative-date-range
n
(keyword unit)
offset-n
(some-> offset-unit keyword)
(js->clj options :keywordize-keys true))) |
Given Matching is based on finding the basically plausible matches first. There is often zero or one plausible matches, and this can return quickly. If there are multiple plausible matches, they are disambiguated by the most important extra included in the
| (defn ^:export find-matching-column [a-query stage-number a-ref columns] (lib.core/find-matching-column a-query stage-number a-ref columns)) |
Does given query stage have any clauses? | (defn ^:export has-clauses [a-query stage-number] (lib.core/has-clauses? a-query stage-number)) |
Returns the count of stages in query | (defn ^:export stage-count [a-query] (lib.core/stage-count a-query)) |
Provides a reasonable display name for the Falls back to the full filter display-name | (defn ^:export filter-args-display-name [a-query stage-number a-filter-clause] (lib.core/filter-args-display-name a-query stage-number a-filter-clause)) |
Create an expression clause from | (defn ^:export expression-clause-for-legacy-expression
[a-query stage-number legacy-expression]
(lib.convert/with-aggregation-list (lib.core/aggregations a-query stage-number)
(let [expr (js->clj legacy-expression :keywordize-keys true)
expr (first (mbql.normalize/normalize-fragment [:query :aggregation] [expr]))]
(lib.convert/->pMBQL expr)))) |
Create a legacy expression from | (defn ^:export legacy-expression-for-expression-clause
[a-query stage-number an-expression-clause]
(lib.convert/with-aggregation-list (lib.core/aggregations a-query stage-number)
(let [legacy-expr (-> an-expression-clause lib.convert/->legacy-MBQL)]
(clj->js (cond-> legacy-expr
(and (vector? legacy-expr)
(#{:aggregation-options :value} (first legacy-expr)))
(get 1)))))) |
Info about whether the column in question has FieldValues associated with it for purposes of powering a search widget in the QB filter modals. | (defn ^:export field-values-search-info
[metadata-providerable column]
(-> (lib.field/field-values-search-info metadata-providerable column)
(update :has-field-values name)
(update-keys cljs-key->js-key)
clj->js)) |
Add or update a filter against a | (defn ^:export update-lat-lon-filter
[a-query stage-number latitude-column longitude-column bounds]
(let [bounds (js->clj bounds :keywordize-keys true)
latitude-column (legacy-column->metadata a-query stage-number latitude-column)
longitude-column (legacy-column->metadata a-query stage-number longitude-column)]
(lib.core/update-lat-lon-filter a-query stage-number latitude-column longitude-column bounds))) |
Add or update a filter against | (defn ^:export update-numeric-filter
[a-query stage-number numeric-column start end]
(let [numeric-column (legacy-column->metadata a-query stage-number numeric-column)]
(lib.core/update-numeric-filter a-query stage-number numeric-column start end))) |
Add or update a filter against | (defn ^:export update-temporal-filter
[a-query stage-number temporal-column start end]
(let [temporal-column (legacy-column->metadata a-query stage-number temporal-column)]
(lib.core/update-temporal-filter a-query stage-number temporal-column start end))) |
Given two CLJS | (defn ^:export valid-filter-for? [src-column dst-column] (lib.types.isa/valid-filter-for? src-column dst-column)) |
(ns metabase.lib.js.metadata (:require [clojure.core.protocols] [clojure.string :as str] [clojure.walk :as walk] [goog] [goog.object :as gobject] [medley.core :as m] [metabase.lib.metadata.protocols :as lib.metadata.protocols] [metabase.lib.util :as lib.util] [metabase.util :as u] [metabase.util.log :as log])) | |
metabase-lib/metadata/Metadata comes in an object like { databases: {}, tables: {}, fields: {}, metrics: {}, segments: {}, questions: {}, } where keys are a map of String ID => metadata | |
Even tho [[u/->kebab-case-en]] has LRU memoization, plain memoization is significantly faster, and since the keys we're parsing here are bounded it's fine to memoize this stuff forever. | (def ^:private ^{:arglists '([k])} memoized-kebab-key
(memoize u/->kebab-case-en)) |
(defn- object-get [obj k]
(when (and obj (js-in k obj))
(gobject/get obj k))) | |
Convert a JS object of any class to a ClojureScript object. | (defn- obj->clj
([xform obj]
(obj->clj xform obj {}))
([xform obj {:keys [use-plain-object?] :or {use-plain-object? true}}]
(if (map? obj)
;; already a ClojureScript object.
(into {} xform obj)
;; has a plain-JavaScript `_plainObject` attached: apply `xform` to it and call it a day
(if-let [plain-object (when use-plain-object?
(some-> (object-get obj "_plainObject")
js->clj
not-empty))]
(into {} xform plain-object)
;; otherwise do things the hard way and convert an arbitrary object into a Cljs map. (`js->clj` doesn't work on
;; arbitrary classes other than `Object`)
(into {}
(comp
(map (fn [k]
[k (object-get obj k)]))
;; ignore values that are functions
(remove (fn [[_k v]]
(js-fn? v)))
xform)
(js-keys obj)))))) |
this intentionally does not use the lib hierarchy since it's not dealing with MBQL/lib keys | (defmulti ^:private excluded-keys
{:arglists '([object-type])}
keyword) |
(defmethod excluded-keys :default [_] nil) | |
Return a function with the signature (f k v) => v' For parsing an individual field. yes, the multimethod could dispatch on object-type AND k and get called for every object, but that would be slow, by doing it this way we only need to do it once. | (defmulti ^:private parse-field-fn
{:arglists '([object-type])}
keyword) |
(defmethod parse-field-fn :default [_object-type] nil) | |
The metadata type that should be attached the sorts of metadatas with the | (defmulti ^:private lib-type
{:arglists '([object-type])}
keyword) |
Returns a function of the keys, either renaming each one or preserving it. If this function returns nil for a given key, the original key is preserved. Use [[excluded-keys]] to drop keys from the input. Defaults to nil, which means no renaming is done. | (defmulti ^:private rename-key-fn identity) |
(defmethod rename-key-fn :default [_] nil) | |
(defn- parse-object-xform [object-type]
(let [excluded-keys-set (excluded-keys object-type)
parse-field (parse-field-fn object-type)
rename-key (rename-key-fn object-type)]
(comp
;; convert keys to kebab-case keywords
(map (fn [[k v]]
[(cond-> (keyword (memoized-kebab-key k))
rename-key (#(or (rename-key %) %)))
v]))
;; remove [[excluded-keys]]
(if (empty? excluded-keys-set)
identity
(remove (fn [[k _v]]
(contains? excluded-keys-set k))))
;; parse each key with its [[parse-field-fn]]
(if-not parse-field
identity
(map (fn [[k v]]
[k (parse-field k v)])))))) | |
(defmulti ^:private parse-object-fn*
{:arglists '([object-type opts])}
(fn
[object-type _opts]
object-type)) | |
(defn- parse-object-fn
([object-type] (parse-object-fn* object-type {}))
([object-type opts] (parse-object-fn* object-type opts))) | |
(defmethod parse-object-fn* :default
[object-type opts]
(let [xform (parse-object-xform object-type)
lib-type-name (lib-type object-type)]
(fn [object]
(try
(let [parsed (assoc (obj->clj xform object opts) :lib/type lib-type-name)]
(log/debugf "Parsed metadata %s %s\n%s" object-type (:id parsed) (u/pprint-to-str parsed))
parsed)
(catch js/Error e
(log/errorf e "Error parsing %s %s: %s" object-type (pr-str object) (ex-message e))
nil))))) | |
(defmulti ^:private parse-objects
{:arglists '([object-type metadata])}
(fn [object-type _metadata]
(keyword object-type))) | |
Key to use to get unparsed objects of this type from the metadata, if you're using the default implementation of [[parse-objects]]. | (defmulti ^:private parse-objects-default-key
{:arglists '([object-type])}
keyword) |
(defmethod parse-objects :default
[object-type metadata]
(let [parse-object (parse-object-fn object-type)]
(obj->clj (map (fn [[k v]]
[(parse-long k) (delay (parse-object v))]))
(object-get metadata (parse-objects-default-key object-type))))) | |
(defmethod lib-type :database [_object-type] :metadata/database) | |
(defmethod excluded-keys :database
[_object-type]
#{:tables :fields}) | |
(defmethod parse-field-fn :database
[_object-type]
(fn [k v]
(case k
:dbms-version (js->clj v :keywordize-keys true)
:features (into #{} (map keyword) v)
:native-permissions (keyword v)
v))) | |
(defmethod parse-objects-default-key :database [_object-type] "databases") | |
(defmethod lib-type :table [_object-type] :metadata/table) | |
(defmethod excluded-keys :table
[_object-type]
#{:database :fields :segments :metrics :dimension-options}) | |
(defmethod parse-field-fn :table
[_object-type]
(fn [k v]
(case k
:entity-type (keyword v)
:field-order (keyword v)
:initial-sync-status (keyword v)
:visibility-type (keyword v)
v))) | |
(defmethod parse-objects :table
[object-type metadata]
(let [parse-table (parse-object-fn object-type)]
(obj->clj (comp (remove (fn [[k _v]]
(str/starts-with? k "card__")))
(map (fn [[k v]]
[(parse-long k) (delay (parse-table v))])))
(object-get metadata "tables")))) | |
(defmethod lib-type :field [_object-type] :metadata/column) | |
(defmethod excluded-keys :field
[_object-type]
#{:_comesFromEndpoint
:database
:default-dimension-option
:dimension-options
:metrics
:table}) | |
(defmethod rename-key-fn :field
[_object-type]
{:source :lib/source
:unit :metabase.lib.field/temporal-unit
:expression-name :lib/expression-name
:binning-info :metabase.lib.field/binning
:dimensions ::dimension
:values ::field-values}) | |
(defn- parse-field-id
[id]
(cond-> id
;; sometimes instead of an ID we get a field reference
;; with the name of the column in the second position
(vector? id) second)) | |
(defn- parse-binning-info
[m]
(obj->clj
(map (fn [[k v]]
(let [k (keyword (memoized-kebab-key k))
k (if (= k :binning-strategy)
:strategy
k)
v (if (= k :strategy)
(keyword v)
v)]
[k v])))
m)) | |
(defn- parse-field-values [field-values]
(when (= (object-get field-values "type") "full")
{:values (js->clj (object-get field-values "values"))
:human-readable-values (js->clj (object-get field-values "human_readable_values"))})) | |
| (defn- parse-dimension
[dimensions]
(when-let [dimension (m/find-first (fn [dimension]
(#{"external" "internal"} (object-get dimension "type")))
dimensions)]
(let [dimension-type (keyword (object-get dimension "type"))]
(merge
{:id (object-get dimension "id")
:name (object-get dimension "name")}
(case dimension-type
;; external = mapped to a different column
:external
{:lib/type :metadata.column.remapping/external
:field-id (object-get dimension "human_readable_field_id")}
;; internal = mapped to FieldValues
:internal
{:lib/type :metadata.column.remapping/internal}))))) |
(defmethod parse-field-fn :field
[_object-type]
(fn [k v]
(case k
:base-type (keyword v)
:coercion-strategy (keyword v)
:effective-type (keyword v)
:fingerprint (if (map? v)
(walk/keywordize-keys v)
(js->clj v :keywordize-keys true))
:has-field-values (keyword v)
:lib/source (case v
"aggregation" :source/aggregations
"breakout" :source/breakouts
(keyword "source" v))
:metabase.lib.field/temporal-unit (keyword v)
:semantic-type (keyword v)
:visibility-type (keyword v)
:id (parse-field-id v)
:metabase.lib.field/binning (parse-binning-info v)
::field-values (parse-field-values v)
::dimension (parse-dimension v)
v))) | |
(defmethod parse-object-fn* :field
[object-type opts]
(let [f ((get-method parse-object-fn* :default) object-type opts)]
(fn [unparsed]
(let [{{dimension-type :lib/type, :as dimension} ::dimension, ::keys [field-values], :as parsed} (f unparsed)]
(-> (case dimension-type
:metadata.column.remapping/external
(assoc parsed :lib/external-remap dimension)
:metadata.column.remapping/internal
(assoc parsed :lib/internal-remap (merge dimension field-values))
parsed)
(dissoc ::dimension ::field-values)))))) | |
(defmethod parse-objects :field
[object-type metadata]
(let [parse-object (parse-object-fn object-type)
unparsed-fields (object-get metadata "fields")]
(obj->clj (keep (fn [[k v]]
;; Sometimes fields coming from saved questions are only present with their ID
;; prefixed with "card__<card-id>:". For such keys we parse the field ID from
;; the suffix and use the entry unless the ID is present in the metadata without
;; prefix. (The assumption being that the data under the two keys are mostly the
;; same but the one under the plain key is to be preferred.)
(when-let [field-id (or (parse-long k)
(when-let [[_ id-str] (re-matches #"card__\d+:(\d+)" k)]
(and (nil? (object-get unparsed-fields id-str))
(parse-long id-str))))]
[field-id (delay (parse-object v))])))
unparsed-fields))) | |
(defmethod lib-type :card [_object-type] :metadata/card) | |
(defmethod excluded-keys :card
[_object-type]
#{:database
:db
:dimension-options
:fks
:metadata
:metrics
:plain-object
:segments
:schema
:schema-name
:table}) | |
(defn- parse-fields [fields] (mapv (parse-object-fn :field) fields)) | |
(defmethod parse-field-fn :card
[_object-type]
(fn [k v]
(case k
:result-metadata (if ((some-fn sequential? array?) v)
(parse-fields v)
(js->clj v :keywordize-keys true))
:fields (parse-fields v)
:visibility-type (keyword v)
:dataset-query (js->clj v :keywordize-keys true)
:dataset v
;; this is not complete, add more stuff as needed.
v))) | |
Sometimes a card is stored in the metadata as some sort of weird object where the thing we actually want is under the
key | (defn- unwrap-card
[obj]
(or (object-get obj "_card")
obj)) |
(defn- assemble-card
[metadata id]
(let [parse-card-ignoring-plain-object (parse-object-fn :card {:use-plain-object? false})
parse-card (parse-object-fn :card)]
;; The question objects might not contain the fields so we merge them
;; in from the table matadata.
(merge
(-> metadata
(object-get "tables")
(object-get (str "card__" id))
;; _plainObject can contain field names in the field property
;; instead of the field objects themselves. Ignoring this
;; property makes sure we parse the real fields.
parse-card-ignoring-plain-object
(assoc :id id))
(-> metadata
(object-get "questions")
(object-get (str id))
unwrap-card
parse-card)))) | |
(defmethod parse-objects :card
[_object-type metadata]
(into {}
(map (fn [id]
[id (delay (assemble-card metadata id))]))
(-> #{}
(into (keep lib.util/legacy-string-table-id->card-id)
(js-keys (object-get metadata "tables")))
(into (map parse-long)
(js-keys (object-get metadata "questions")))))) | |
(defmethod lib-type :metric [_object-type] :metadata/metric) | |
(defmethod excluded-keys :metric
[_object-type]
#{:database :table}) | |
(defmethod parse-field-fn :metric
[_object-type]
(fn [_k v]
v)) | |
(defmethod parse-objects-default-key :metric [_object-type] "metrics") | |
(defmethod lib-type :segment [_object-type] :metadata/segment) | |
(defmethod excluded-keys :segment
[_object-type]
#{:database :table}) | |
(defmethod parse-field-fn :segment
[_object-type]
(fn [_k v]
v)) | |
(defmethod parse-objects-default-key :segment [_object-type] "segments") | |
(defn- parse-objects-delay [object-type metadata]
(delay
(try
(parse-objects object-type metadata)
(catch js/Error e
(log/errorf e "Error parsing %s objects: %s" object-type (ex-message e))
nil)))) | |
(defn- parse-metadata [metadata]
{:databases (parse-objects-delay :database metadata)
:tables (parse-objects-delay :table metadata)
:fields (parse-objects-delay :field metadata)
:cards (parse-objects-delay :card metadata)
:metrics (parse-objects-delay :metric metadata)
:segments (parse-objects-delay :segment metadata)}) | |
(defn- database [metadata database-id] (some-> metadata :databases deref (get database-id) deref)) | |
(defn- table [metadata table-id] (some-> metadata :tables deref (get table-id) deref)) | |
(defn- field [metadata field-id] (some-> metadata :fields deref (get field-id) deref)) | |
(defn- card [metadata card-id] (some-> metadata :cards deref (get card-id) deref)) | |
(defn- metric [metadata metric-id] (some-> metadata :metrics deref (get metric-id) deref)) | |
(defn- segment [metadata segment-id] (some-> metadata :segments deref (get segment-id) deref)) | |
(defn- tables [metadata database-id]
(for [[_id table-delay] (some-> metadata :tables deref)
:let [a-table (some-> table-delay deref)]
:when (and a-table (= (:db-id a-table) database-id))]
a-table)) | |
(defn- fields [metadata table-id]
(for [[_id field-delay] (some-> metadata :fields deref)
:let [a-field (some-> field-delay deref)]
:when (and a-field (= (:table-id a-field) table-id))]
a-field)) | |
(defn- metrics [metadata table-id]
(for [[_id metric-delay] (some-> metadata :metrics deref)
:let [a-metric (some-> metric-delay deref)]
:when (and a-metric (= (:table-id a-metric) table-id))]
a-metric)) | |
(defn- segments [metadata table-id]
(for [[_id segment-delay] (some-> metadata :segments deref)
:let [a-segment (some-> segment-delay deref)]
:when (and a-segment (= (:table-id a-segment) table-id))]
a-segment)) | |
(defn- setting [setting-key ^js unparsed-metadata]
(-> unparsed-metadata
(object-get "settings")
(object-get (name setting-key)))) | |
Use a | (defn metadata-provider
[database-id unparsed-metadata]
(let [metadata (parse-metadata unparsed-metadata)]
(log/debug "Created metadata provider for metadata")
(reify lib.metadata.protocols/MetadataProvider
(database [_this] (database metadata database-id))
(table [_this table-id] (table metadata table-id))
(field [_this field-id] (field metadata field-id))
(metric [_this metric-id] (metric metadata metric-id))
(segment [_this segment-id] (segment metadata segment-id))
(card [_this card-id] (card metadata card-id))
(tables [_this] (tables metadata database-id))
(fields [_this table-id] (fields metadata table-id))
(metrics [_this table-id] (metrics metadata table-id))
(segments [_this table-id] (segments metadata table-id))
(setting [_this setting-key] (setting setting-key unparsed-metadata))
;; for debugging: call [[clojure.datafy/datafy]] on one of these to parse all of our metadata and see the whole
;; thing at once.
clojure.core.protocols/Datafiable
(datafy [_this]
(walk/postwalk
(fn [form]
(if (delay? form)
(deref form)
form))
metadata))))) |
Parses a JS column provided by the FE into a :metadata/column value for use in MLv2. | (def parse-column (parse-object-fn :field)) |
(ns metabase.lib.limit (:require [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.util :as lib.util] [metabase.shared.util.i18n :as i18n] [metabase.util.malli :as mu])) | |
(defmethod lib.metadata.calculation/describe-top-level-key-method :limit
[query stage-number _k]
(when-let [limit (:limit (lib.util/query-stage query stage-number))]
(str limit \space (i18n/trun "row" "rows" limit)))) | |
(mu/defn ^:export limit :- ::lib.schema/query
"Set the maximum number of rows to be returned by a stage of a query to `n`. If `n` is `nil`, remove the limit."
([query n]
(limit query -1 n))
([query :- ::lib.schema/query
stage-number :- :int
n :- [:maybe ::lib.schema.common/positive-int]]
(lib.util/update-query-stage query stage-number (fn [stage]
(if n
(assoc stage :limit n)
(dissoc stage :limit)))))) | |
(mu/defn ^:export current-limit :- [:maybe ::lib.schema.common/positive-int]
"Get the maximum number of rows to be returned by a stage of a query. `nil` indicates there is no limit"
([query :- ::lib.schema/query]
(current-limit query -1))
([query :- ::lib.schema/query
stage-number :- :int]
(:limit (lib.util/query-stage query stage-number)))) | |
(ns metabase.lib.metadata (:require [metabase.lib.metadata.protocols :as lib.metadata.protocols] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.id :as lib.schema.id] [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.lib.util :as lib.util] [metabase.util.malli :as mu])) | |
Column vs Field? Lately I've been using | |
Malli schema for a valid map of column metadata, which can mean one of two things:
Now maybe these should be two different schemas, but | (def ColumnMetadata [:ref ::lib.schema.metadata/column]) |
Schema for metadata about a specific Saved Question (which may or may not be a Model). More or less the same as
a [[metabase.models.card]], but with kebab-case keys. Note that the | (def CardMetadata [:ref ::lib.schema.metadata/card]) |
More or less the same as a [[metabase.models.segment]], but with kebab-case keys. | (def SegmentMetadata [:ref ::lib.schema.metadata/segment]) |
Malli schema for a legacy v1 [[metabase.models.metric]], but with kebab-case keys. A Metric defines an MBQL snippet
with an aggregation and optionally a filter clause. You can add a | (def MetricMetadata [:ref ::lib.schema.metadata/metric]) |
Schema for metadata about a specific [[metabase.models.table]]. More or less the same as a [[metabase.models.table]], but with kebab-case keys. | (def TableMetadata [:ref ::lib.schema.metadata/table]) |
Malli schema for the DatabaseMetadata as returned by | (def DatabaseMetadata [:ref ::lib.schema.metadata/database]) |
Schema for something that satisfies the [[lib.metadata.protocols/MetadataProvider]] protocol. | (def MetadataProvider [:ref ::lib.schema.metadata/metadata-provider]) |
Something that can be used to get a MetadataProvider. Either a MetadataProvider, or a map with a MetadataProvider in
the key | (def MetadataProviderable [:ref ::lib.schema.metadata/metadata-providerable]) |
(mu/defn ->metadata-provider :- MetadataProvider
"Get a MetadataProvider from something that can provide one."
[metadata-providerable :- MetadataProviderable]
(if (lib.metadata.protocols/metadata-provider? metadata-providerable)
metadata-providerable
(:lib/metadata metadata-providerable))) | |
(mu/defn database :- DatabaseMetadata "Get metadata about the Database we're querying." [metadata-providerable :- MetadataProviderable] (lib.metadata.protocols/database (->metadata-provider metadata-providerable))) | |
(mu/defn tables :- [:sequential TableMetadata] "Get metadata about all Tables for the Database we're querying." [metadata-providerable :- MetadataProviderable] (lib.metadata.protocols/tables (->metadata-provider metadata-providerable))) | |
(mu/defn table :- TableMetadata "Find metadata for a specific Table, either by string `table-name`, and optionally `schema`, or by ID." [metadata-providerable :- MetadataProviderable table-id :- ::lib.schema.id/table] (lib.metadata.protocols/table (->metadata-provider metadata-providerable) table-id)) | |
(mu/defn fields :- [:sequential ColumnMetadata] "Get metadata about all the Fields belonging to a specific Table." [metadata-providerable :- MetadataProviderable table-id :- ::lib.schema.id/table] (lib.metadata.protocols/fields (->metadata-provider metadata-providerable) table-id)) | |
(mu/defn field :- [:maybe ColumnMetadata] "Get metadata about a specific Field in the Database we're querying." [metadata-providerable :- MetadataProviderable field-id :- ::lib.schema.id/field] (lib.metadata.protocols/field (->metadata-provider metadata-providerable) field-id)) | |
(mu/defn setting :- any?
"Get the value of a Metabase setting for the instance we're querying."
([metadata-providerable :- MetadataProviderable
setting-key :- [:or string? keyword?]]
(lib.metadata.protocols/setting (->metadata-provider metadata-providerable) setting-key))) | |
Stage metadata | |
Metadata about the columns returned by a particular stage of a pMBQL query. For example a single-stage native query like {:database 1 :lib/type :mbql/query :stages [{:lib/type :mbql.stage/mbql :native "SELECT id, name FROM VENUES;"}]} might have stage metadata like {:columns [{:name "id", :base-type :type/Integer} {:name "name", :base-type :type/Text}]} associated with the query's lone stage. At some point in the near future we will hopefully attach this metadata directly to each stage in a query, so a
multi-stage query will have This is the same format as the results metadata returned with QP results in Note that queries currently actually come back with both | (def StageMetadata [:map [:lib/type [:= :metadata/results]] [:columns [:sequential ColumnMetadata]]]) |
(mu/defn stage :- [:maybe StageMetadata] "Get metadata associated with a particular `stage-number` of the query, if any. `stage-number` can be a negative index. Currently, only returns metadata if it is explicitly attached to a stage; in the future we will probably dynamically calculate this stuff if possible based on DatabaseMetadata and previous stages. Stay tuned!" [query :- :map stage-number :- :int] (:lib/stage-metadata (lib.util/query-stage query stage-number))) | |
(mu/defn stage-column :- [:maybe ColumnMetadata]
"Metadata about a specific column returned by a specific stage of the query, e.g. perhaps the first stage of the
query has an expression `num_cans`, then
(lib.metadata/stage-column query stage \"num_cans\")
should return something like
{:name \"num_cans\", :base-type :type/Integer, ...}
This is currently a best-effort thing and will only return information about columns if stage metadata is attached
to a particular stage. In the near term future this should be better about calculating that metadata dynamically and
returning correct info here."
([query :- :map
column-name :- ::lib.schema.common/non-blank-string]
(stage-column query -1 column-name))
([query :- :map
stage-number :- :int
column-name :- ::lib.schema.common/non-blank-string]
(some (fn [column]
(when (= (:name column) column-name)
column))
(:columns (stage query stage-number))))) | |
(mu/defn card :- [:maybe CardMetadata] "Get metadata for a Card, aka Saved Question, with `card-id`, if it can be found." [metadata-providerable :- MetadataProviderable card-id :- ::lib.schema.id/card] (lib.metadata.protocols/card (->metadata-provider metadata-providerable) card-id)) | |
(mu/defn segment :- [:maybe SegmentMetadata] "Get metadata for the Segment with `segment-id`, if it can be found." [metadata-providerable :- MetadataProviderable segment-id :- ::lib.schema.id/segment] (lib.metadata.protocols/segment (->metadata-provider metadata-providerable) segment-id)) | |
(mu/defn metric :- [:maybe MetricMetadata] "Get metadata for the Metric with `metric-id`, if it can be found." [metadata-providerable :- MetadataProviderable metric-id :- ::lib.schema.id/metric] (lib.metadata.protocols/metric (->metadata-provider metadata-providerable) metric-id)) | |
(mu/defn table-or-card :- [:maybe [:or CardMetadata TableMetadata]]
"Convenience, for frontend JS usage (see #31915): look up metadata based on Table ID, handling legacy-style
`card__<id>` strings as well. Throws an Exception (Clj-only, due to Malli validation) if passed an integer Table ID
and the Table does not exist, since this is a real error; however if passed a `card__<id>` that does not exist,
simply returns `nil` (since we do not have a strict expectation that Cards always be present in the
MetadataProvider)."
[metadata-providerable :- MetadataProviderable
table-id :- [:or ::lib.schema.id/table :string]]
(if-let [card-id (lib.util/legacy-string-table-id->card-id table-id)]
(card metadata-providerable card-id)
(table metadata-providerable table-id))) | |
(mu/defn editable? :- :boolean
"Given a query, returns whether it is considered editable.
There's no editable flag! Instead, a query is **not** editable if:
- Database is missing from the metadata (no permissions at all);
- Database is present but it doesn't have native write permissions;
- Database is present but tables (at least the `:source-table`) are missing (missing table permissions); or
- Similarly, the card specified by `:source-card` is missing from the metadata.
If metadata for the `:source-table` or `:source-card` can be found, then the query is editable."
[query :- ::lib.schema/query]
(let [{:keys [source-table source-card] :as stage0} (lib.util/query-stage query 0)]
(boolean (and (when-let [{:keys [id]} (database query)]
(= (:database query) id))
(or (and source-table (table query source-table))
(and source-card (card query source-card))
(and
(= (:lib/type stage0) :mbql.stage/native)
;; Couldn't import and use `lib.native/has-write-permissions` here due to a circular dependency
;; TODO Find a way to unify has-write-permissions and this function?
(= :write (:native-permissions (database query))))))))) | |
(ns metabase.lib.metadata.composed-provider (:require [clojure.core.protocols] [clojure.datafy :as datafy] [medley.core :as m] [metabase.lib.metadata.protocols :as metadata.protocols])) | |
(defn- cached-providers [providers]
(filter #(satisfies? metadata.protocols/CachedMetadataProvider %)
providers)) | |
(defn- object-for-id [f id metadata-providers]
(some (fn [provider]
(f provider id))
metadata-providers)) | |
(defn- objects-for-table-id [f table-id metadata-providers]
(into []
(comp
(mapcat (fn [provider]
(f provider table-id)))
(m/distinct-by :id))
metadata-providers)) | |
A metadata provider composed of several different | (defn composed-metadata-provider
[& metadata-providers]
(reify
metadata.protocols/MetadataProvider
(database [_this] (some metadata.protocols/database metadata-providers))
(table [_this table-id] (object-for-id metadata.protocols/table table-id metadata-providers))
(field [_this field-id] (object-for-id metadata.protocols/field field-id metadata-providers))
(card [_this card-id] (object-for-id metadata.protocols/card card-id metadata-providers))
(metric [_this metric-id] (object-for-id metadata.protocols/metric metric-id metadata-providers))
(segment [_this segment-id] (object-for-id metadata.protocols/segment segment-id metadata-providers))
(setting [_this setting-name] (object-for-id metadata.protocols/setting setting-name metadata-providers))
(tables [_this] (m/distinct-by :id (mapcat metadata.protocols/tables metadata-providers)))
(fields [_this table-id] (objects-for-table-id metadata.protocols/fields table-id metadata-providers))
(metrics [_this table-id] (objects-for-table-id metadata.protocols/metrics table-id metadata-providers))
(segments [_this table-id] (objects-for-table-id metadata.protocols/segments table-id metadata-providers))
metadata.protocols/CachedMetadataProvider
(cached-database [_this]
(some metadata.protocols/cached-database
(cached-providers metadata-providers)))
(cached-metadata [_this metadata-type id]
(some #(metadata.protocols/cached-metadata % metadata-type id)
(cached-providers metadata-providers)))
(store-database! [_this database-metadata]
(when-first [provider (cached-providers metadata-providers)]
(metadata.protocols/store-database! provider database-metadata)))
(store-metadata! [_this metadata-type id metadata]
(when-first [provider (cached-providers metadata-providers)]
(metadata.protocols/store-metadata! provider metadata-type id metadata)))
clojure.core.protocols/Datafiable
(datafy [_this]
(cons `composed-metadata-provider (map datafy/datafy metadata-providers))))) |
Implementation(s) of [[metabase.lib.metadata.protocols/MetadataProvider]] only for the JVM. | (ns metabase.lib.metadata.jvm
(:require
[clojure.string :as str]
[metabase.lib.metadata :as lib.metadata]
[metabase.lib.metadata.cached-provider :as lib.metadata.cached-provider]
[metabase.lib.metadata.protocols :as lib.metadata.protocols]
[metabase.lib.schema.id :as lib.schema.id]
[metabase.models.interface :as mi]
[metabase.models.setting :as setting]
[metabase.plugins.classloader :as classloader]
[metabase.util :as u]
[metabase.util.malli :as mu]
[metabase.util.snake-hating-map :as u.snake-hating-map]
[methodical.core :as methodical]
[potemkin :as p]
[pretty.core :as pretty]
#_{:clj-kondo/ignore [:discouraged-namespace]}
[toucan2.core :as t2]
[toucan2.model :as t2.model]
[toucan2.pipeline :as t2.pipeline]
[toucan2.query :as t2.query])) |
(set! *warn-on-reflection* true) | |
(defn- qualified-key? [k]
(or (qualified-keyword? k)
(str/includes? k "."))) | |
Calculating the kebab-case version of a key every time is pretty slow (even with the LRU caching [[u/->kebab-case-en]] has), since the keys here are static and finite we can just memoize them forever and get a nice performance boost. | (def ^:private ^{:arglists '([k])} memoized-kebab-key
;; we spent a lot of time messing around with different ways of doing this and this seems to be the fastest. See
;; https://metaboat.slack.com/archives/C04CYTEL9N2/p1702671632956539 -- Cam
(let [cache (java.util.concurrent.ConcurrentHashMap.)
mapping-fn (reify java.util.function.Function
(apply [_this k]
(u/->kebab-case-en k)))]
(fn [k]
(.computeIfAbsent cache k mapping-fn)))) |
Convert a (presumably) Toucan 2 instance of an application database model with | (defn instance->metadata
[instance metadata-type]
(-> instance
(update-keys memoized-kebab-key)
(assoc :lib/type metadata-type)
u.snake-hating-map/snake-hating-map)) |
Database | |
(derive :metadata/database :model/Database) | |
(methodical/defmethod t2.model/resolve-model :metadata/database [model] (classloader/require 'metabase.models.database) model) | |
(methodical/defmethod t2.pipeline/build [#_query-type :toucan.query-type/select.*
#_model :metadata/database
#_resolved-query clojure.lang.IPersistentMap]
[query-type model parsed-args honeysql]
(merge (next-method query-type model parsed-args honeysql)
{:select [:id :engine :name :dbms_version :settings :is_audit :details :timezone]})) | |
(t2/define-after-select :metadata/database
[database]
;; ignore encrypted details that we cannot decrypt, because that breaks schema
;; validation
(let [database (instance->metadata database :metadata/database)]
(cond-> database
(not (map? (:details database))) (dissoc :details)))) | |
Table | |
(derive :metadata/table :model/Table) | |
(methodical/defmethod t2.model/resolve-model :metadata/table [model] (classloader/require 'metabase.models.table) model) | |
(methodical/defmethod t2.pipeline/build [#_query-type :toucan.query-type/select.*
#_model :metadata/table
#_resolved-query clojure.lang.IPersistentMap]
[query-type model parsed-args honeysql]
(merge (next-method query-type model parsed-args honeysql)
{:select [:id :db_id :name :display_name :schema :active :visibility_type]})) | |
(t2/define-after-select :metadata/table [table] (instance->metadata table :metadata/table)) | |
Field | |
(derive :metadata/column :model/Field) | |
(methodical/defmethod t2.model/resolve-model :metadata/column
[model]
(classloader/require 'metabase.models.dimension
'metabase.models.field
'metabase.models.field-values
'metabase.models.table)
model) | |
(methodical/defmethod t2.model/model->namespace :metadata/column
":metadata/column joins Dimension and FieldValues by default; namespace their columns so we can distinguish them from
the columns coming back from Field."
[_model]
{:model/Dimension "dimension"
:model/FieldValues "values"}) | |
(methodical/defmethod t2.query/apply-kv-arg [#_model :metadata/column
#_resolved-query clojure.lang.IPersistentMap
#_k :default]
"Qualify unqualified kv-args when fetching a `:metadata/column`."
[model honeysql k v]
(let [k (if (not (qualified-key? k))
(keyword "field" (name k))
k)]
(next-method model honeysql k v))) | |
(methodical/defmethod t2.pipeline/build [#_query-type :toucan.query-type/select.*
#_model :metadata/column
#_resolved-query clojure.lang.IPersistentMap]
[query-type model parsed-args honeysql]
(merge
(next-method query-type model parsed-args honeysql)
{:select [:field/base_type
:field/coercion_strategy
:field/database_type
:field/description
:field/display_name
:field/effective_type
:field/fingerprint
:field/fk_target_field_id
:field/id
:field/name
:field/nfc_path
:field/parent_id
:field/position
:field/semantic_type
:field/settings
:field/table_id
:field/visibility_type
:dimension/human_readable_field_id
:dimension/id
:dimension/name
:dimension/type
:values/human_readable_values
:values/values]
:from [[(t2/table-name :model/Field) :field]]
:left-join [[(t2/table-name :model/Table) :table]
[:= :field/table_id :table/id]
[(t2/table-name :model/Dimension) :dimension]
[:and
[:= :dimension/field_id :field/id]
[:inline [:in :dimension/type ["external" "internal"]]]]
[(t2/table-name :model/FieldValues) :values]
[:and
[:= :values/field_id :field/id]
[:= :values/type [:inline "full"]]]]})) | |
(t2/define-after-select :metadata/column
[field]
(let [field (instance->metadata field :metadata/column)
dimension-type (some-> (:dimension/type field) keyword)]
(merge
(dissoc field
:dimension/human-readable-field-id :dimension/id :dimension/name :dimension/type
:values/human-readable-values :values/values)
(when (and (= dimension-type :external)
(:dimension/human-readable-field-id field))
{:lib/external-remap {:lib/type :metadata.column.remapping/external
:id (:dimension/id field)
:name (:dimension/name field)
:field-id (:dimension/human-readable-field-id field)}})
(when (and (= dimension-type :internal)
(:values/values field)
(:values/human-readable-values field))
{:lib/internal-remap {:lib/type :metadata.column.remapping/internal
:id (:dimension/id field)
:name (:dimension/name field)
:values (mi/json-out-with-keywordization
(:values/values field))
:human-readable-values (mi/json-out-without-keywordization
(:values/human-readable-values field))}})))) | |
Card | |
(derive :metadata/card :model/Card) | |
(methodical/defmethod t2.model/resolve-model :metadata/card
[model]
(classloader/require 'metabase.models.card
'metabase.models.persisted-info)
model) | |
(methodical/defmethod t2.model/model->namespace :metadata/card
[_model]
{:model/PersistedInfo "persisted"}) | |
(methodical/defmethod t2.query/apply-kv-arg [#_model :metadata/card
#_resolved-query clojure.lang.IPersistentMap
#_k :default]
[model honeysql k v]
()
(let [k (if (not (qualified-key? k))
(keyword "card" (name k))
k)]
(next-method model honeysql k v))) | |
(methodical/defmethod t2.pipeline/build [#_query-type :toucan.query-type/select.*
#_model :metadata/card
#_resolved-query clojure.lang.IPersistentMap]
[query-type model parsed-args honeysql]
(merge
(next-method query-type model parsed-args honeysql)
{:select [:card/collection_id
:card/database_id
:card/dataset
:card/dataset_query
:card/id
:card/name
:card/result_metadata
:card/table_id
:card/visualization_settings
:persisted/active
:persisted/state
:persisted/definition
:persisted/query_hash
:persisted/table_name]
:from [[(t2/table-name :model/Card) :card]]
:left-join [[(t2/table-name :model/PersistedInfo) :persisted]
[:= :persisted/card_id :card/id]]})) | |
(defn- parse-persisted-info-definition [x] ((get-in (t2/transforms :model/PersistedInfo) [:definition :out] identity) x)) | |
(t2/define-after-select :metadata/card
[card]
(let [card (instance->metadata card :metadata/card)]
(merge
(dissoc card :persisted/active :persisted/state :persisted/definition :persisted/query-hash :persisted/table-name)
(when (:persisted/definition card)
{:lib/persisted-info {:active (:persisted/active card)
:state (:persisted/state card)
:definition (parse-persisted-info-definition (:persisted/definition card))
:query-hash (:persisted/query-hash card)
:table-name (:persisted/table-name card)}})))) | |
Metric | |
(derive :metadata/metric :model/Metric) | |
(methodical/defmethod t2.model/resolve-model :metadata/metric [model] (classloader/require 'metabase.models.metric) model) | |
(methodical/defmethod t2.query/apply-kv-arg [#_model :metadata/metric
#_resolved-query clojure.lang.IPersistentMap
#_k :default]
[model honeysql k v]
(let [k (if (not (qualified-key? k))
(keyword "metric" (name k))
k)]
(next-method model honeysql k v))) | |
(methodical/defmethod t2.pipeline/build [#_query-type :toucan.query-type/select.*
#_model :metadata/metric
#_resolved-query clojure.lang.IPersistentMap]
[query-type model parsed-args honeysql]
(merge
(next-method query-type model parsed-args honeysql)
{:select [:metric/id
:metric/table_id
:metric/name
:metric/description
:metric/archived
:metric/definition]
:from [[(t2/table-name :model/Metric) :metric]]
:left-join [[(t2/table-name :model/Table) :table]
[:= :metric/table_id :table/id]]})) | |
(t2/define-after-select :metadata/metric [metric] (instance->metadata metric :metadata/metric)) | |
Segment | |
(derive :metadata/segment :model/Segment) | |
(methodical/defmethod t2.model/resolve-model :metadata/segment
[model]
(classloader/require 'metabase.models.segment
'metabase.models.table)
model) | |
(methodical/defmethod t2.query/apply-kv-arg [#_model :metadata/segment
#_resolved-query clojure.lang.IPersistentMap
#_k :default]
[model honeysql k v]
(let [k (if (not (qualified-key? k))
(keyword "segment" (name k))
k)]
(next-method model honeysql k v))) | |
(methodical/defmethod t2.pipeline/build [#_query-type :toucan.query-type/select.*
#_model :metadata/segment
#_resolved-query clojure.lang.IPersistentMap]
[query-type model parsed-args honeysql]
(merge
(next-method query-type model parsed-args honeysql)
{:select [:segment/id
:segment/table_id
:segment/name
:segment/description
:segment/archived
:segment/definition]
:from [[(t2/table-name :model/Segment) :segment]]
:left-join [[(t2/table-name :model/Table) :table]
[:= :segment/table_id :table/id]]})) | |
(t2/define-after-select :metadata/segment [segment] (instance->metadata segment :metadata/segment)) | |
MetadataProvider | |
(p/deftype+ UncachedApplicationDatabaseMetadataProvider [database-id]
lib.metadata.protocols/MetadataProvider
(database [_this]
(when-not database-id
(throw (ex-info (format "Cannot use %s with %s with a nil Database ID"
`lib.metadata.protocols/database
`UncachedApplicationDatabaseMetadataProvider)
{})))
(t2/select-one :metadata/database database-id))
(table [_this table-id] (t2/select-one :metadata/table :id table-id :db_id database-id))
(field [_this field-id] (t2/select-one :metadata/column :id field-id :table/db_id database-id))
(card [_this card-id] (t2/select-one :metadata/card :id card-id :database_id database-id))
(metric [_this metric-id] (t2/select-one :metadata/metric :id metric-id :table/db_id database-id))
(segment [_this segment-id] (t2/select-one :metadata/segment :id segment-id :table/db_id database-id))
(tables [_this]
(t2/select :metadata/table
:db_id database-id
:active true
:visibility_type [:not-in #{"hidden" "technical" "cruft"}]))
(fields [_this table-id]
(t2/select :metadata/column
:table_id table-id
:active true
:visibility_type [:not-in #{"sensitive" "retired"}]))
(metrics [_this table-id]
(t2/select :metadata/metric :table_id table-id, :archived false))
(segments [_this table-id]
(t2/select :metadata/segment :table_id table-id, :archived false))
(setting [_this setting-name]
(setting/get setting-name))
lib.metadata.protocols/BulkMetadataProvider
(bulk-metadata [_this metadata-type ids]
(let [database-id-key (case metadata-type
:metadata/table :db_id
:metadata/card :database_id
:table/db_id)]
(when (seq ids)
(t2/select metadata-type
database-id-key database-id
:id [:in (set ids)]))))
pretty/PrettyPrintable
(pretty [_this]
(list `->UncachedApplicationDatabaseMetadataProvider database-id))) | |
(mu/defn application-database-metadata-provider :- lib.metadata/MetadataProvider "An implementation of [[metabase.lib.metadata.protocols/MetadataProvider]] for the application database. The application database metadata provider implements both of the optional protocols, [[metabase.lib.metadata.protocols/CachedMetadataProvider]] and [[metabase.lib.metadata.protocols/BulkMetadataProvider]]. All operations are cached; so you can use the bulk operations to pre-warm the cache if you need to." [database-id :- ::lib.schema.id/database] (lib.metadata.cached-provider/cached-metadata-provider (->UncachedApplicationDatabaseMetadataProvider database-id))) | |
A Metric is a saved MBQL query stage snippet with EXACTLY ONE | (ns metabase.lib.metric (:require [metabase.lib.aggregation :as lib.aggregation] [metabase.lib.convert :as lib.convert] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.metadata.protocols :as lib.metadata.protocols] [metabase.lib.ref :as lib.ref] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.expression :as lib.schema.expression] [metabase.lib.util :as lib.util] [metabase.mbql.normalize :as mbql.normalize] [metabase.shared.util.i18n :as i18n] [metabase.util.malli :as mu])) |
(defn- resolve-metric [query metric-id]
(when (integer? metric-id)
(lib.metadata/metric query metric-id))) | |
(mu/defn ^:private metric-definition :- [:maybe ::lib.schema/stage.mbql]
[{:keys [definition], :as _metric-metadata} :- lib.metadata/MetricMetadata]
(when definition
(if (:mbql/type definition)
definition
;; legacy; needs conversion
(->
;; database-id cannot be nil, but gets thrown out
(lib.convert/legacy-query-from-inner-query #?(:clj Integer/MAX_VALUE :cljs js/Number.MAX_SAFE_INTEGER) definition)
mbql.normalize/normalize
lib.convert/->pMBQL
(lib.util/query-stage -1))))) | |
(defmethod lib.ref/ref-method :metadata/metric
[{:keys [id], :as metric-metadata}]
(let [effective-type (or (:effective-type metric-metadata)
(:base-type metric-metadata)
(when-let [aggregation (first (:aggregation (metric-definition metric-metadata)))]
(let [ag-effective-type (lib.schema.expression/type-of aggregation)]
(when (isa? ag-effective-type :type/*)
ag-effective-type))))
options (cond-> {:lib/uuid (str (random-uuid))}
effective-type (assoc :effective-type effective-type))]
[:metric options id])) | |
(defmethod lib.metadata.calculation/type-of-method :metadata/metric
[query stage-number metric-metadata]
(or
(when-let [[aggregation] (not-empty (:aggregation (metric-definition metric-metadata)))]
(lib.metadata.calculation/type-of query stage-number aggregation))
:type/*)) | |
(defmethod lib.metadata.calculation/type-of-method :metric
[query stage-number [_tag _opts metric-id-or-name]]
(or (when-let [metric-metadata (resolve-metric query metric-id-or-name)]
(lib.metadata.calculation/type-of query stage-number metric-metadata))
:type/*)) | |
(defn- fallback-display-name [] (i18n/tru "[Unknown Metric]")) | |
(defmethod lib.metadata.calculation/display-name-method :metadata/metric
[_query _stage-number metric-metadata _style]
(or ((some-fn :display-name :name) metric-metadata)
(fallback-display-name))) | |
(defmethod lib.metadata.calculation/display-name-method :metric
[query stage-number [_tag _opts metric-id-or-name] style]
(or (when-let [metric-metadata (resolve-metric query metric-id-or-name)]
(lib.metadata.calculation/display-name query stage-number metric-metadata style))
(fallback-display-name))) | |
(defmethod lib.metadata.calculation/display-info-method :metadata/metric [query stage-number metric-metadata] (merge ((get-method lib.metadata.calculation/display-info-method :default) query stage-number metric-metadata) (select-keys metric-metadata [:description :aggregation-position]))) | |
(defmethod lib.metadata.calculation/display-info-method :metric
[query stage-number [_tag _opts metric-id-or-name]]
(if-let [metric-metadata (resolve-metric query metric-id-or-name)]
(lib.metadata.calculation/display-info query stage-number metric-metadata)
{:effective-type :type/*
:display-name (fallback-display-name)
:long-display-name (fallback-display-name)})) | |
(defmethod lib.metadata.calculation/column-name-method :metric
[query stage-number [_tag _opts metric-id-or-name]]
(or (when-let [metric-metadata (resolve-metric query metric-id-or-name)]
(lib.metadata.calculation/column-name query stage-number metric-metadata))
"metric")) | |
(mu/defn available-metrics :- [:maybe [:sequential {:min 1} lib.metadata/MetricMetadata]]
"Get a list of Metrics that you may consider using as aggregations for a query. Only Metrics that have the same
`table-id` as the `source-table` for this query will be suggested."
([query]
(available-metrics query -1))
([query :- ::lib.schema/query
stage-number :- :int]
(when (zero? (lib.util/canonical-stage-index query stage-number))
(when-let [source-table-id (lib.util/source-table-id query)]
(let [metrics (lib.metadata.protocols/metrics (lib.metadata/->metadata-provider query) source-table-id)
metric-aggregations (into {}
(keep-indexed (fn [index aggregation-clause]
(when (lib.util/clause-of-type? aggregation-clause :metric)
[(get aggregation-clause 2) index])))
(lib.aggregation/aggregations query stage-number))]
(cond
(empty? metrics) nil
(empty? metric-aggregations) (vec metrics)
:else (mapv (fn [metric-metadata]
(let [aggregation-pos (-> metric-metadata :id metric-aggregations)]
(cond-> metric-metadata
aggregation-pos (assoc :aggregation-position aggregation-pos))))
metrics))))))) | |
Functions for working with native queries. | (ns metabase.lib.native (:require [clojure.set :as set] [clojure.string :as str] [medley.core :as m] [metabase.lib.metadata :as lib.metadata] [metabase.lib.query :as lib.query] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.common :as common] [metabase.lib.schema.template-tag :as lib.schema.template-tag] [metabase.lib.util :as lib.util] [metabase.shared.util.i18n :as i18n] [metabase.util.humanization :as u.humanization] [metabase.util.malli :as mu] [metabase.util.malli.registry :as mr])) |
(def ^:private variable-tag-regex
#"\{\{\s*([A-Za-z0-9_\.]+)\s*\}\}") | |
(def ^:private snippet-tag-regex
#"\{\{\s*(snippet:\s*[^}]+)\s*\}\}") | |
(def ^:private card-tag-regex
#"\{\{\s*(#([0-9]*)(-[a-z0-9-]*)?)\s*\}\}") | |
(def ^:private tag-regexes [variable-tag-regex snippet-tag-regex card-tag-regex]) | |
(mu/defn ^:private recognize-template-tags :- [:set ::common/non-blank-string]
"Given the text of a native query, extract a possibly-empty set of template tag strings from it."
[query-text :- ::common/non-blank-string]
(into #{}
(comp (mapcat #(re-seq % query-text))
(map second))
tag-regexes)) | |
(defn- tag-name->card-id [tag-name]
(when-let [[_ id-str] (re-matches #"^#(\d+)(-[a-z0-9-]*)?$" tag-name)]
(parse-long id-str))) | |
(defn- tag-name->snippet-name [tag-name]
(when (str/starts-with? tag-name "snippet:")
(str/trim (subs tag-name (count "snippet:"))))) | |
(defn- fresh-tag [tag-name]
{:type :text
:name tag-name
:id (str (random-uuid))}) | |
(defn- finish-tag [{tag-name :name :as tag}]
(merge tag
(when-let [card-id (tag-name->card-id tag-name)]
{:type :card
:card-id card-id})
(when-let [snippet-name (tag-name->snippet-name tag-name)]
{:type :snippet
:snippet-name snippet-name})
(when-not (:display-name tag)
{:display-name (u.humanization/name->human-readable-name :simple tag-name)}))) | |
(defn- rename-template-tag
[existing-tags old-name new-name]
(let [old-tag (get existing-tags old-name)
display-name (if (= (:display-name old-tag)
(u.humanization/name->human-readable-name :simple old-name))
;; Replace the display name if it was the default; keep it if customized.
(u.humanization/name->human-readable-name :simple new-name)
(:display-name old-tag))
new-tag (-> old-tag
(dissoc :snippet-name :card-id :snippet-id)
(assoc :display-name display-name
:name new-name))]
(-> existing-tags
(dissoc old-name)
(assoc new-name new-tag)))) | |
(defn- unify-template-tags
[query-tag-names existing-tags existing-tag-names]
(let [new-tags (set/difference query-tag-names existing-tag-names)
old-tags (set/difference existing-tag-names query-tag-names)
tags (if (= 1 (count new-tags) (count old-tags))
;; With exactly one change, we treat it as a rename.
(rename-template-tag existing-tags (first old-tags) (first new-tags))
;; With more than one change, just drop the old ones and add the new.
(merge (m/remove-keys old-tags existing-tags)
(m/index-by :name (map fresh-tag new-tags))))]
(update-vals tags finish-tag))) | |
(mu/defn extract-template-tags :- ::lib.schema.template-tag/template-tag-map
"Extract the template tags from a native query's text.
If the optional map of existing tags previously parsed is given, this will reuse the existing tags where
they match up with the new one (in particular, it will preserve the UUIDs).
Given the text of a native query, extract a possibly-empty set of template tag strings from it.
These looks like mustache templates. For variables, we only allow alphanumeric characters, eg. `{{foo}}`.
For snippets they start with `snippet:`, eg. `{{ snippet: arbitrary text here }}`.
And for card references either `{{ #123 }}` or with the optional human label `{{ #123-card-title-slug }}`.
Invalid patterns are simply ignored, so something like `{{&foo!}}` is just disregarded."
([query-text :- ::common/non-blank-string]
(extract-template-tags query-text nil))
([query-text :- ::common/non-blank-string
existing-tags :- [:maybe ::lib.schema.template-tag/template-tag-map]]
(let [query-tag-names (not-empty (recognize-template-tags query-text))
existing-tag-names (not-empty (set (keys existing-tags)))]
(if (or query-tag-names existing-tag-names)
;; If there's at least some tags, unify them.
(unify-template-tags query-tag-names existing-tags existing-tag-names)
;; Otherwise just an empty map, no tags.
{})))) | |
(defn- assert-native-query! [stage] (assert (= (:lib/type stage) :mbql.stage/native) (i18n/tru "Must be a native query"))) | |
(def ^:private all-native-extra-keys
#{:collection}) | |
(mr/def ::native-extras
[:map
[:collection {:optional true} ::common/non-blank-string]]) | |
(mu/defn required-native-extras :- set?
"Returns the extra keys that are required for this database's native queries, for example `:collection` name is
needed for MongoDB queries."
[metadata-provider :- lib.metadata/MetadataProviderable]
(let [db (lib.metadata/database metadata-provider)]
(cond-> #{}
(get-in db [:features :native-requires-specified-collection])
(conj :collection)))) | |
(mu/defn with-native-extras :- ::lib.schema/query
"Updates the extras required for the db to run this query.
The first stage must be a native type. Will ignore extras not in `required-native-extras`"
[query :- ::lib.schema/query
native-extras :- [:maybe ::native-extras]]
(let [required-extras (required-native-extras query)]
(lib.util/update-query-stage
query 0
(fn [stage]
(let [extras-to-remove (set/difference all-native-extra-keys required-extras)
stage-without-old-extras (apply dissoc stage extras-to-remove)
result (merge stage-without-old-extras (select-keys native-extras required-extras))
missing-keys (set/difference required-extras (set (keys native-extras)))]
(assert-native-query! (lib.util/query-stage query 0))
(assert (empty? missing-keys)
(i18n/tru "Missing extra, required keys for native query: {0}"
(pr-str missing-keys)))
result))))) | |
(mu/defn native-query :- ::lib.schema/query
"Create a new native query.
Native in this sense means a pMBQL query with a first stage that is a native query."
([metadata-providerable :- lib.metadata/MetadataProviderable
inner-query :- ::common/non-blank-string]
(native-query metadata-providerable inner-query nil nil))
([metadata-providerable :- lib.metadata/MetadataProviderable
inner-query :- ::common/non-blank-string
results-metadata :- [:maybe lib.metadata/StageMetadata]
native-extras :- [:maybe ::native-extras]]
(let [tags (extract-template-tags inner-query)]
(-> (lib.query/query-with-stages metadata-providerable
[{:lib/type :mbql.stage/native
:lib/stage-metadata results-metadata
:template-tags tags
:native inner-query}])
(with-native-extras native-extras))))) | |
(mu/defn with-different-database :- ::lib.schema/query
"Changes the database for this query. The first stage must be a native type.
Native extras must be provided if the new database requires it."
([query :- ::lib.schema/query
metadata-provider :- lib.metadata/MetadataProviderable]
(with-different-database query metadata-provider nil))
([query :- ::lib.schema/query
metadata-provider :- lib.metadata/MetadataProviderable
native-extras :- [:maybe ::native-extras]]
(assert-native-query! (lib.util/query-stage query 0))
;; Changing the database should also clean up template tags, see #31926
(-> (lib.query/query-with-stages metadata-provider (:stages query))
(with-native-extras native-extras)))) | |
(mu/defn native-extras :- [:maybe ::native-extras] "Returns the extra keys for native queries associated with this query." [query :- ::lib.schema/query] (not-empty (select-keys (lib.util/query-stage query 0) (required-native-extras query)))) | |
(mu/defn with-native-query :- ::lib.schema/query
"Update the raw native query, the first stage must already be a native type.
Replaces templates tags"
[query :- ::lib.schema/query
inner-query :- ::common/non-blank-string]
(lib.util/update-query-stage
query 0
(fn [{existing-tags :template-tags :as stage}]
(assert-native-query! stage)
(assoc stage
:native inner-query
:template-tags (extract-template-tags inner-query existing-tags))))) | |
(mu/defn with-template-tags :- ::lib.schema/query
"Updates the native query's template tags."
[query :- ::lib.schema/query
tags :- ::lib.schema.template-tag/template-tag-map]
(lib.util/update-query-stage
query 0
(fn [{existing-tags :template-tags :as stage}]
(assert-native-query! stage)
(let [valid-tags (keys existing-tags)]
(assoc stage :template-tags
(m/deep-merge existing-tags (select-keys tags valid-tags))))))) | |
(mu/defn raw-native-query :- ::common/non-blank-string "Returns the native query string" [query :- ::lib.schema/query] (:native (lib.util/query-stage query 0))) | |
(mu/defn template-tags :- ::lib.schema.template-tag/template-tag-map "Returns the native query's template tags" [query :- ::lib.schema/query] (:template-tags (lib.util/query-stage query 0))) | |
(mu/defn has-write-permission :- :boolean "Returns whether the database has native write permissions. This is only filled in by [[metabase.api.database/add-native-perms-info]] and added to metadata when pulling a database from the list of dbs in js." [query :- ::lib.schema/query] (assert-native-query! (lib.util/query-stage query 0)) (= :write (:native-permissions (lib.metadata/database query)))) | |
(defmethod lib.query/can-run-method :mbql.stage/native
[query]
(and
(set/subset? (required-native-extras query)
(set (keys (native-extras query))))
(not (str/blank? (raw-native-query query))))) | |
(mu/defn engine :- :keyword "Returns the database engine. Must be a native query" [query :- ::lib.schema/query] (assert-native-query! (lib.util/query-stage query 0)) (:engine (lib.metadata/database query))) | |
(ns metabase.lib.normalize (:require [metabase.lib.dispatch :as lib.dispatch] [metabase.lib.hierarchy :as lib.hierarchy])) | |
(defn- mbql-clause-type [x]
(when (and (vector? x)
((some-fn keyword? string?) (first x)))
(keyword (first x)))) | |
(defn- map-type [m]
(when (map? m)
(some-> (or
(:lib/type m)
(get m "lib/type"))
keyword))) | |
(defn- dispatch-value [x] (or (mbql-clause-type x) (map-type x) (keyword (lib.dispatch/dispatch-value x)))) | |
Ensure some part of an MBQL query The default implementation will keywordize keys for maps, and convert some known keys using [[default-map-value-fns]]; for MBQL clauses, it will convert the clause name to a keyword and recursively normalize its options and arguments. Implement this method if you need custom behavior for something. | (defmulti normalize
{:arglists '([x])}
dispatch-value
:hierarchy lib.hierarchy/hierarchy) |
Default normalization functions keys when doing map normalization. | (def default-map-value-fns
{:base-type keyword
:effective-type keyword
:semantic-type keyword
:type keyword
;; we can calculate `:field_ref` now using [[metabase.lib.ref/ref]]; `:field_ref` is wrong half of the time anyway,
;; so ignore it.
:field_ref (constantly ::do-not-use-me)
:lib/type keyword
:lib/options normalize}) |
[[normalize]] a map using This is the default implementation for maps. Custom map implementations can call this with a different | (defn normalize-map
([m]
(normalize-map m keyword))
([m key-fn]
(normalize-map m key-fn nil))
([m key-fn value-fns]
(let [value-fns (merge default-map-value-fns value-fns)]
(into {}
(map (fn [[k v]]
(let [k (key-fn k)]
[k
(if-let [f (get value-fns k)]
(f v)
v)])))
m)))) |
(defmethod normalize :dispatch-type/map [m] (normalize-map m)) | |
(defn- default-normalize-mbql-clause [[tag opts & args]]
(into [(keyword tag) (normalize opts)]
(map normalize)
args)) | |
(defmethod normalize :default
[x]
(cond
(mbql-clause-type x) (default-normalize-mbql-clause x)
(map-type x) (normalize-map x)
:else x)) | |
(defn- maybe-normalize-token
[expression k]
(cond-> expression
(string? (get expression k)) (update k keyword))) | |
(defmethod normalize :time-interval
[[_ _ _ amount _unit :as expression]]
(cond-> (default-normalize-mbql-clause expression)
(= "current" amount) (update 3 keyword)
:always (maybe-normalize-token 4))) | |
(defmethod normalize :relative-datetime
[[_ _ amount _unit :as expression]]
(cond-> (default-normalize-mbql-clause expression)
(= "current" amount) (update 2 keyword)
:always (maybe-normalize-token 3))) | |
(defmethod normalize :interval
[expression]
(-> (default-normalize-mbql-clause expression)
(maybe-normalize-token 3))) | |
(defmethod normalize :datetime-add
[expression]
(-> (default-normalize-mbql-clause expression)
(maybe-normalize-token 4))) | |
(defmethod normalize :datetime-subtract
[expression]
(-> (default-normalize-mbql-clause expression)
(maybe-normalize-token 4))) | |
(defmethod normalize :get-week
[expression]
(-> (default-normalize-mbql-clause expression)
(maybe-normalize-token 3))) | |
(defmethod normalize :temporal-extract
[expression]
(-> (default-normalize-mbql-clause expression)
(maybe-normalize-token 3)
(maybe-normalize-token 4))) | |
(defmethod normalize :datetime-diff
[expression]
(-> (default-normalize-mbql-clause expression)
(maybe-normalize-token 4))) | |
(ns metabase.lib.options (:refer-clojure :exclude [uuid]) (:require [metabase.lib.schema.common :as lib.schema.common] [metabase.shared.util.i18n :as i18n] [metabase.util :as u] [metabase.util.malli :as mu])) | |
TODO -- not 100% sure we actually need all of this stuff anymore. | |
(defn- mbql-clause? [x]
(and (vector? x)
(keyword? (first x)))) | |
(mu/defn options :- [:maybe map?]
"Return the Metabase lib options map associated with an `x`. Lib options is currently used mostly for
the `:lib/uuid` we attach to everything to facilitate removing or replacing clauses later, but we will probably
stick more stuff in here in the future. Some clauses like `:field` use options extensively for different things.
Normally for an MBQL clause, options are an optional second argument, e.g.
[:= {:lib/uuid \"03baa510-0415-48ef-987a-462d789c8a02\"} 1 2]
a la Hiccup or Malli. The default implementation already knows how to handle clauses that follow this shape. For
historic reasons some MBQL clauses like `:field` or some of the string filter clauses have options as the last
argument; you'll have to implement this method, and [[with-options]], to deal with the special cases.
For maps like join specs, options are currently stored under the `:lib/options` key. Does this make sense? Not sure.
Maybe options should be included directly in the map, but then we'd have to decide which keys are and are not
options. Is a join `:alias` an option? Probably. What about a `:condition`? It's not optional. So for purposes of
writing Metabase lib and tracking `:lib/uuid`, this approach seems ok in the short term."
[x]
(cond
(map? x)
(:lib/options x)
(mbql-clause? x)
(when (map? (second x))
(second x))
:else
nil)) | |
Update If You should probably prefer [[update-options]] to using this directly, so you don't stomp over existing stuff unintentionally. Implement this if you need to teach Metabase lib how to support something that doesn't follow the usual patterns described in [[options]]. | (mu/defn with-options
[x new-options :- [:maybe map?]]
(cond
(map? x)
(u/assoc-dissoc x :lib/options (not-empty new-options))
(mbql-clause? x)
(if ((some-fn nil? map?) (second x))
(assoc (vec x) 1 new-options)
(into [(first x) new-options] (rest x)))
:else
(throw (ex-info (i18n/tru "Don''t know how to set options for {0}" (pr-str x))
{:x x})))) |
Update the existing options in an (apply f existing-options args) | (defn update-options
[x f & args]
(let [current-options (options x)
new-options (apply f current-options args)]
(with-options x new-options))) |
Check that | (defn ensure-uuid
[x]
(update-options x (fn [options-map]
(cond-> options-map
(not (:lib/uuid options-map))
(assoc :lib/uuid (str (random-uuid))))))) |
(mu/defn uuid :- [:maybe ::lib.schema.common/non-blank-string] "Get the `:lib/uuid` associated with something, e.g. an MBQL clause or join." [x] (:lib/uuid (options x))) | |
(ns metabase.lib.order-by (:require [metabase.lib.aggregation :as lib.aggregation] [metabase.lib.breakout :as lib.breakout] [metabase.lib.dispatch :as lib.dispatch] [metabase.lib.equality :as lib.equality] [metabase.lib.hierarchy :as lib.hierarchy] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.options :as lib.options] [metabase.lib.ref :as lib.ref] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.expression :as lib.schema.expression] [metabase.lib.schema.order-by :as lib.schema.order-by] [metabase.lib.util :as lib.util] [metabase.mbql.util.match :as mbql.u.match] [metabase.shared.util.i18n :as i18n] [metabase.util.malli :as mu])) | |
(lib.hierarchy/derive :asc ::order-by-clause) (lib.hierarchy/derive :desc ::order-by-clause) | |
(defmethod lib.metadata.calculation/describe-top-level-key-method :order-by
[query stage-number _k]
(when-let [order-bys (not-empty (:order-by (lib.util/query-stage query stage-number)))]
(i18n/tru "Sorted by {0}"
(lib.util/join-strings-with-conjunction
(i18n/tru "and")
(for [order-by order-bys]
(lib.metadata.calculation/display-name query stage-number order-by :long)))))) | |
(defmethod lib.metadata.calculation/display-name-method ::order-by-clause
[query stage-number [tag _opts expr] style]
(let [expr-display-name (lib.metadata.calculation/display-name query stage-number expr style)]
(case tag
:asc (i18n/tru "{0} ascending" expr-display-name)
:desc (i18n/tru "{0} descending" expr-display-name)))) | |
(defmethod lib.metadata.calculation/display-info-method ::order-by-clause
[query stage-number [tag _opts expr]]
(assoc (lib.metadata.calculation/display-info query stage-number expr)
:direction tag)) | |
(defmulti ^:private order-by-clause-method
{:arglists '([orderable])}
lib.dispatch/dispatch-value
:hierarchy lib.hierarchy/hierarchy) | |
(defmethod order-by-clause-method ::order-by-clause [clause] (lib.options/ensure-uuid clause)) | |
by default, try to convert | (defmethod order-by-clause-method :default
[x]
(when (nil? x)
(throw (ex-info (i18n/tru "Can''t order by nil") {})))
(lib.options/ensure-uuid [:asc (lib.ref/ref x)])) |
(mu/defn ^:private with-direction :- ::lib.schema.order-by/order-by "Update the direction of an order by clause." [clause :- ::lib.schema.order-by/order-by direction :- ::lib.schema.order-by/direction] (assoc (vec clause) 0 direction)) | |
Create an order-by clause independently of a query, e.g. for | (mu/defn order-by-clause
([orderable]
(order-by-clause orderable :asc))
([orderable :- some?
direction :- [:maybe [:enum :asc :desc]]]
(-> (order-by-clause-method orderable)
(with-direction (or direction :asc))))) |
Add an MBQL order-by clause (i.e., You can teach Metabase lib how to generate order by clauses for different things by implementing the underlying [[order-by-clause-method]] multimethod. | (mu/defn order-by
([query orderable]
(order-by query -1 orderable nil))
([query orderable direction]
(order-by query -1 orderable direction))
([query
stage-number :- [:maybe :int]
orderable :- some?
direction :- [:maybe [:enum :asc :desc]]]
(let [stage-number (or stage-number -1)
new-order-by (cond-> (order-by-clause-method orderable)
direction (with-direction direction))]
(lib.util/update-query-stage query stage-number update :order-by (fn [order-bys]
(conj (vec order-bys) new-order-by)))))) |
(mu/defn order-bys :- [:maybe [:sequential ::lib.schema.order-by/order-by]]
"Get the order-by clauses in a query."
([query :- ::lib.schema/query]
(order-bys query -1))
([query :- ::lib.schema/query
stage-number :- :int]
(not-empty (get (lib.util/query-stage query stage-number) :order-by)))) | |
(defn- orderable-column? [{:keys [base-type], :as _column-metadata}]
(some (fn [orderable-base-type]
(isa? base-type orderable-base-type))
lib.schema.expression/orderable-types)) | |
(mu/defn orderable-columns :- [:sequential lib.metadata/ColumnMetadata]
"Get column metadata for all the columns you can order by in a given `stage-number` of a `query`. Rules are as
follows:
1. If the stage has aggregations or breakouts, you can only order by those columns. E.g.
SELECT id, count(*) AS count FROM core_user GROUP BY id ORDER BY count ASC;
You can't ORDER BY something not in the SELECT, e.g. ORDER BY user.first_name would not make sense here.
2. If the stage has no aggregations or breakouts, you can order by any visible Field:
a. You can filter by any custom `:expressions` in this stage of the query
b. You can filter by any Field 'exported' by the previous stage of the query, if there is one; otherwise you can
filter by any Fields from the current `:source-table`.
c. You can filter by any Fields exported by any explicit joins
d. You can filter by and Fields in Tables that are implicitly joinable."
([query :- ::lib.schema/query]
(orderable-columns query -1))
([query :- ::lib.schema/query
stage-number :- :int]
(let [breakouts (not-empty (lib.breakout/breakouts-metadata query stage-number))
aggregations (not-empty (lib.aggregation/aggregations-metadata query stage-number))
columns (if (or breakouts aggregations)
(concat breakouts aggregations)
(let [stage (lib.util/query-stage query stage-number)
options {:include-implicitly-joinable-for-source-card? false}]
(lib.metadata.calculation/visible-columns query stage-number stage options)))
columns (filter orderable-column? columns)
existing-order-bys (->> (order-bys query stage-number)
(map (fn [[_tag _opts expr]]
expr)))]
(cond
(empty? columns)
nil
(empty? existing-order-bys)
(vec columns)
:else
(let [matching (into {}
(comp (map lib.ref/ref)
(keep-indexed (fn [index an-order-by]
(when-let [col (lib.equality/find-matching-column
query stage-number an-order-by columns)]
[col index]))))
existing-order-bys)]
(mapv #(let [pos (matching %)]
(cond-> %
pos (assoc :order-by-position pos)))
columns)))))) | |
(def ^:private opposite-direction
{:asc :desc
:desc :asc}) | |
(mu/defn change-direction :- ::lib.schema/query
"Flip the direction of `current-order-by` in `query`."
([query :- ::lib.schema/query
current-order-by :- ::lib.schema.order-by/order-by]
(let [lib-uuid (lib.options/uuid current-order-by)]
(mbql.u.match/replace query
[direction (_ :guard #(= (:lib/uuid %) lib-uuid)) _]
(assoc &match 0 (opposite-direction direction)))))) | |
(ns metabase.lib.query (:refer-clojure :exclude [remove]) (:require [malli.core :as mc] [medley.core :as m] [metabase.lib.convert :as lib.convert] [metabase.lib.dispatch :as lib.dispatch] [metabase.lib.expression :as lib.expression] [metabase.lib.hierarchy :as lib.hierarchy] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.normalize :as lib.normalize] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.id :as lib.schema.id] [metabase.lib.util :as lib.util] [metabase.mbql.util :as mbql.u] [metabase.util :as u] [metabase.util.malli :as mu])) | |
(defmethod lib.normalize/normalize :mbql/query
[query]
(lib.normalize/normalize-map
query
keyword
{:type keyword
:stages (partial mapv lib.normalize/normalize)})) | |
(defmethod lib.metadata.calculation/metadata-method :mbql/query
[_query _stage-number _query]
;; not i18n'ed because this shouldn't be developer-facing.
(throw (ex-info "You can't calculate a metadata map for a query! Use lib.metadata.calculation/returned-columns-method instead."
{}))) | |
(defmethod lib.metadata.calculation/returned-columns-method :mbql/query [query stage-number a-query options] (lib.metadata.calculation/returned-columns query stage-number (lib.util/query-stage a-query stage-number) options)) | |
(defmethod lib.metadata.calculation/display-name-method :mbql/query [query stage-number x style] (lib.metadata.calculation/display-name query stage-number (lib.util/query-stage x stage-number) style)) | |
(mu/defn native? :- :boolean
"Given a query, return whether it is a native query."
[query :- ::lib.schema/query]
(let [stage (lib.util/query-stage query 0)]
(= (:lib/type stage) :mbql.stage/native))) | |
(defmethod lib.metadata.calculation/display-info-method :mbql/query
[_query _stage-number query]
{:is-native (native? query)
:is-editable (lib.metadata/editable? query)}) | |
(mu/defn stage-count :- ::lib.schema.common/int-greater-than-or-equal-to-zero "Returns the count of stages in query" [query :- ::lib.schema/query] (count (:stages query))) | |
Returns whether the query is runnable based on first stage :lib/type | (defmulti can-run-method
(fn [query]
(:lib/type (lib.util/query-stage query 0)))) |
(defmethod can-run-method :default [_query] true) | |
(mu/defn can-run :- :boolean
"Returns whether the query is runnable. Manually validate schema for cljs."
[query :- ::lib.schema/query]
(and (mc/validate ::lib.schema/query query)
(boolean (can-run-method query)))) | |
(mu/defn query-with-stages :- ::lib.schema/query
"Create a query from a sequence of stages."
([metadata-providerable stages]
(query-with-stages (:id (lib.metadata/database metadata-providerable)) metadata-providerable stages))
([database-id :- ::lib.schema.id/database
metadata-providerable :- lib.metadata/MetadataProviderable
stages]
{:lib/type :mbql/query
:lib/metadata (lib.metadata/->metadata-provider metadata-providerable)
:database database-id
:stages stages})) | |
Create a query from a specific stage. | (mu/defn query-with-stage
([metadata-providerable stage]
(query-with-stages metadata-providerable [stage]))
([database-id :- ::lib.schema.id/database
metadata-providerable :- lib.metadata/MetadataProviderable
stage]
(query-with-stages database-id metadata-providerable [stage]))) |
(mu/defn ^:private query-from-existing :- ::lib.schema/query
[metadata-providerable :- lib.metadata/MetadataProviderable
query :- lib.util/LegacyOrPMBQLQuery]
(let [query (lib.convert/->pMBQL query)]
(query-with-stages metadata-providerable (:stages query)))) | |
Implementation for [[query]]. | (defmulti ^:private query-method
{:arglists '([metadata-providerable x])}
(fn [_metadata-providerable x]
(lib.dispatch/dispatch-value x))
:hierarchy lib.hierarchy/hierarchy) |
(defmethod query-method :dispatch-type/map [metadata-providerable query] (query-from-existing metadata-providerable query)) | |
this should already be a query in the shape we want but: - let's make sure it has the database metadata that was passed in - fill in field refs with metadata (#33680) - fill in top expression refs with metadata | (defmethod query-method :mbql/query
[metadata-providerable {converted? :lib.convert/converted? :as query}]
(let [metadata-provider (lib.metadata/->metadata-provider metadata-providerable)
query (-> query
(assoc :lib/metadata metadata-provider)
(dissoc :lib.convert/converted?))
stages (:stages query)]
(cond-> query
converted?
(assoc
:stages
(into []
(map (fn [[stage-number stage]]
(mbql.u/replace stage
[:field
(opts :guard (complement (some-fn :base-type :effective-type)))
(field-id :guard (every-pred number? pos?))]
(let [found-ref (-> (lib.metadata/field metadata-provider field-id)
(select-keys [:base-type :effective-type]))]
;; Fallback if metadata is missing
[:field (merge found-ref opts) field-id])
[:expression
(opts :guard (complement (some-fn :base-type :effective-type)))
expression-name]
(let [found-ref (try
(m/remove-vals
#(= :type/* %)
(-> (lib.expression/expression-ref query stage-number expression-name)
second
(select-keys [:base-type :effective-type])))
(catch #?(:clj Exception :cljs :default) _
;; This currently does not find expressions defined in join stages
nil))]
;; Fallback if metadata is missing
[:expression (merge found-ref opts) expression-name]))))
(m/indexed stages)))))) |
(defmethod query-method :metadata/table
[metadata-providerable table-metadata]
(query-with-stages metadata-providerable
[{:lib/type :mbql.stage/mbql
:source-table (u/the-id table-metadata)}])) | |
(defmethod query-method :metadata/card
[metadata-providerable card-metadata]
(query-with-stages metadata-providerable
[{:lib/type :mbql.stage/mbql
:source-card (u/the-id card-metadata)}])) | |
(mu/defn query :- ::lib.schema/query "Create a new MBQL query from anything that could conceptually be an MBQL query, like a Database or Table or an existing MBQL query or saved question or whatever. If the thing in question does not already include metadata, pass it in separately -- metadata is needed for most query manipulation operations." [metadata-providerable :- lib.metadata/MetadataProviderable x] (query-method metadata-providerable x)) | |
(mu/defn query-from-legacy-inner-query :- ::lib.schema/query
"Create a pMBQL query from a legacy inner query."
[metadata-providerable :- lib.metadata/MetadataProviderable
database-id :- ::lib.schema.id/database
inner-query :- :map]
(->> (lib.convert/legacy-query-from-inner-query database-id inner-query)
lib.convert/->pMBQL
(query metadata-providerable))) | |
(mu/defn with-different-table :- ::lib.schema/query "Changes an existing query to use a different source table or card. Can be passed an integer table id or a legacy `card__<id>` string." [original-query :- ::lib.schema/query table-id :- [:or ::lib.schema.id/table :string]] (let [metadata-provider (lib.metadata/->metadata-provider original-query)] (query metadata-provider (lib.metadata/table-or-card metadata-provider table-id)))) | |
(ns metabase.lib.ref (:refer-clojure :exclude [ref]) (:require [metabase.lib.dispatch :as lib.dispatch] [metabase.lib.schema.ref :as lib.schema.ref] [metabase.util.malli :as mu])) | |
Impl for [[ref]]. This should create a new ref every time it is called, i.e. it should have a fresh UUID every time you call it. | (defmulti ref-method
{:arglists '([x])}
lib.dispatch/dispatch-value) |
(mu/defn ref :- ::lib.schema.ref/ref "Create a fresh ref that can be added to a query, e.g. a `:field`, `:aggregation`, or `:expression` reference. Will create a new UUID every time this is called." [x :- some?] (ref-method x)) | |
(ns metabase.lib.remove-replace (:require [clojure.set :as set] [clojure.walk :as walk] [malli.core :as mc] [medley.core :as m] [metabase.lib.common :as lib.common] [metabase.lib.equality :as lib.equality] [metabase.lib.expression :as lib.expression] [metabase.lib.join :as lib.join] [metabase.lib.join.util :as lib.join.util] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.options :as lib.options] [metabase.lib.ref :as lib.ref] [metabase.lib.util :as lib.util] [metabase.mbql.util.match :as mbql.match] [metabase.util :as u] [metabase.util.malli :as mu])) | |
(defn- stage-paths
[query stage-number]
(let [joins (lib.join/joins query stage-number)
join-indices (range (count joins))
join-condition-paths (for [idx join-indices]
[:joins idx :conditions])
join-field-paths (for [idx join-indices
:let [join (nth joins idx)]
;; :fields in a join can be just :all or :none (#31858)
:when (not (keyword? (:fields join)))]
[:joins idx :fields])]
(concat [[:order-by] [:breakout] [:filters] [:fields] [:aggregation] [:expressions]]
join-field-paths
join-condition-paths))) | |
(declare remove-local-references) (declare remove-stage-references) (declare remove-join) (declare normalize-fields-clauses) | |
(defn- find-matching-order-by-index
[query stage-number [target-op {:keys [temporal-unit binning]} target-ref-id]]
(->> (lib.util/query-stage query stage-number)
:order-by
m/indexed
(m/find-first (fn [[_idx [_dir _ ordered-clause]]]
(and (= (first ordered-clause) target-op)
(= (:temporal-unit (second ordered-clause)) temporal-unit)
(= (:binning (second ordered-clause)) binning)
(= (last ordered-clause) target-ref-id))))
first)) | |
(defn- sync-order-by-options-with-breakout
[query stage-number target-clause new-options]
(if-let [order-by-idx (find-matching-order-by-index query stage-number target-clause)]
(lib.util/update-query-stage
query stage-number
update-in [:order-by order-by-idx 2 1]
(comp #(m/remove-vals nil? %) merge)
new-options)
query)) | |
(defn- remove-breakout-order-by
[query stage-number target-clause]
(if-let [order-by-idx (find-matching-order-by-index query stage-number target-clause)]
(lib.util/update-query-stage
query
stage-number
lib.util/remove-clause
[:order-by]
(get-in (lib.util/query-stage query stage-number) [:order-by order-by-idx])
stage-number)
query)) | |
(defn- remove-replace-location
[query stage-number unmodified-query-for-stage location target-clause remove-replace-fn]
(let [result (lib.util/update-query-stage query stage-number
remove-replace-fn location target-clause)
target-uuid (lib.options/uuid target-clause)]
(if (not= query result)
(mbql.match/match-one location
[:expressions]
(-> result
(remove-local-references
stage-number
unmodified-query-for-stage
:expression
{}
(lib.util/expression-name target-clause))
(remove-stage-references stage-number unmodified-query-for-stage target-uuid))
[:aggregation]
(-> result
(remove-local-references
stage-number
unmodified-query-for-stage
:aggregation
{}
target-uuid)
(remove-stage-references stage-number unmodified-query-for-stage target-uuid))
#_{:clj-kondo/ignore [:invalid-arity]}
(:or
[:breakout]
[:fields]
[:joins _ :fields])
(remove-stage-references result stage-number unmodified-query-for-stage target-uuid)
_
result)
result))) | |
(defn- remove-local-references [query stage-number unmodified-query-for-stage target-op target-opts target-ref-id]
(let [stage (lib.util/query-stage query stage-number)
to-remove (mapcat
(fn [location]
(when-let [clauses (get-in stage location)]
(->> clauses
(keep (fn [clause]
(mbql.match/match-one clause
[target-op
(_ :guard #(or (empty? target-opts)
(set/subset? (set target-opts) (set %))))
target-ref-id] [location clause]))))))
(stage-paths query stage-number))
dead-joins (volatile! (transient []))]
(as-> query q
(reduce
(fn [query [location target-clause]]
(remove-replace-location
query stage-number unmodified-query-for-stage location target-clause
#(try (lib.util/remove-clause %1 %2 %3 stage-number)
(catch #?(:clj Exception :cljs js/Error) e
(let [{:keys [error join]} (ex-data e)]
(if (= error :metabase.lib.util/cannot-remove-final-join-condition)
;; Return the stage unchanged, but keep track of the dead joins.
(do (vswap! dead-joins conj! join)
%1)
(throw e)))))))
q
to-remove)
(reduce #(remove-join %1 stage-number %2) q (persistent! @dead-joins))))) | |
(defn- remove-stage-references
[query previous-stage-number unmodified-query-for-stage target-uuid]
(if-let [stage-number (lib.util/next-stage-number unmodified-query-for-stage previous-stage-number)]
(let [stage (lib.util/query-stage unmodified-query-for-stage stage-number)
target-ref-id (->> (lib.metadata.calculation/visible-columns unmodified-query-for-stage stage-number stage)
(some (fn [{:keys [lib/source lib/source-uuid] :as column}]
(when (and (= :source/previous-stage source) (= target-uuid source-uuid))
(:lib/desired-column-alias column)))))]
(if target-ref-id
;; We are moving to the next stage, so pass the current query as the unmodified-query-for-stage
(remove-local-references query stage-number query :field {} target-ref-id)
query))
query)) | |
(defn- remove-replace* [query stage-number target-clause remove-or-replace replacement]
(mu/disable-enforcement
(let [target-clause (lib.common/->op-arg target-clause)
stage (lib.util/query-stage query stage-number)
location (m/find-first
(fn [possible-location]
(when-let [clauses (get-in stage possible-location)]
(let [target-uuid (lib.options/uuid target-clause)]
(when (some (comp #{target-uuid} :lib/uuid second) clauses)
possible-location))))
(stage-paths query stage-number))
replace? (= :replace remove-or-replace)
replacement-clause (when replace?
(lib.common/->op-arg replacement))
remove-replace-fn (if replace?
#(lib.util/replace-clause %1 %2 %3 replacement-clause)
#(lib.util/remove-clause %1 %2 %3 stage-number))
changing-breakout? (= [:breakout] location)
sync-breakout-ordering? (and replace?
changing-breakout?
(and (= (first target-clause)
(first replacement-clause))
(= (last target-clause)
(last replacement-clause))))
query (cond
sync-breakout-ordering?
(sync-order-by-options-with-breakout
query
stage-number
target-clause
(select-keys (second replacement-clause) [:binning :temporal-unit]))
changing-breakout?
(remove-breakout-order-by query stage-number target-clause)
:else
query)]
(if location
(-> query
(remove-replace-location stage-number query location target-clause remove-replace-fn)
normalize-fields-clauses)
query)))) | |
(mu/defn remove-clause :- :metabase.lib.schema/query
"Removes the `target-clause` from the stage specified by `stage-number` of `query`.
If `stage-number` is not specified, the last stage is used."
([query :- :metabase.lib.schema/query
target-clause]
(remove-clause query -1 target-clause))
([query :- :metabase.lib.schema/query
stage-number :- :int
target-clause]
(if (and (map? target-clause) (= (:lib/type target-clause) :mbql/join))
(remove-join query stage-number target-clause)
(remove-replace* query stage-number target-clause :remove nil)))) | |
(defn- fresh-ref [reference] (lib.options/update-options reference assoc :lib/uuid (str (random-uuid)))) | |
(defn- local-replace-expression-references [stage target-ref-id replacement-ref]
(let [replace-embedded-refs (fn replace-refs [stage]
(mbql.match/replace stage
[:expression _ target-ref-id] (fresh-ref replacement-ref)))]
(replace-embedded-refs stage))) | |
(defn- local-replace-expression
[stage target replacement]
(let [replacement-name (or (lib.util/expression-name replacement)
(-> replacement lib.options/options :name))
top-level-replacement (-> replacement
(lib.util/top-level-expression-clause replacement-name)
fresh-ref)
replaced (update stage :expressions (fn [exprs] (mapv #(if (= % target) top-level-replacement %) exprs)))
target-name (lib.util/expression-name target)
replacement-type (-> replacement lib.options/options :effective-type)
replacement-ref [:expression {:effective-type replacement-type} replacement-name]]
(local-replace-expression-references replaced target-name replacement-ref))) | |
(defn- local-replace
[stage target replacement]
(->> (if (lib.util/expression-name target)
(local-replace-expression stage target replacement)
(walk/postwalk #(if (= % target) replacement %) stage))
(walk/postwalk #(if (= % (lib.options/uuid target)) (lib.options/uuid replacement) %)))) | |
(defn- returned-columns-at-stage
[query stage-number]
(->> (lib.util/query-stage query stage-number)
(lib.metadata.calculation/returned-columns query stage-number))) | |
(defn- replaced-columns
[query stage-number replaced]
(let [cols (returned-columns-at-stage query stage-number)
replaced-cols (returned-columns-at-stage replaced stage-number)]
(->> (map vector cols replaced-cols)
(filter #(not= (first %) (second %)))))) | |
(defn- next-stage-replacement
[query next-stage-number [col replaced-col]]
(let [target-ref-id (:lib/desired-column-alias col)
replaced-ref (lib.ref/ref (assoc replaced-col :lib/source :source/previous-stage))]
(map (fn [target-ref] [target-ref (fresh-ref replaced-ref)])
(mbql.match/match (lib.util/query-stage query next-stage-number)
[:field _ target-ref-id] &match)))) | |
(defn- typed-expression
[query stage-number expression]
(if (or (-> expression lib.options/options :effective-type)
(not (lib.expression/expression-clause? expression))
(not (lib.util/clause? expression)))
expression
(let [t (lib.metadata.calculation/type-of query stage-number expression)]
(lib.options/update-options expression assoc :effective-type t)))) | |
(def ^:private expression-validator (mc/validator :metabase.lib.schema.expression/expression)) | |
Returns if | (defn- expression-replacement?
[an-expression new-expression]
(and (expression-validator an-expression)
(expression-validator new-expression))) |
(defn- with-default-name
[target replacement]
(let [target-name (lib.util/expression-name target)]
(cond-> replacement
(and target-name
(not (lib.util/expression-name replacement))
(not (-> replacement lib.options/options :name)))
(lib.util/top-level-expression-clause target-name)))) | |
Return This function can make changes that produce an invalid query. It is expected that the caller checks the result and removes invalid parts or uses an other way to make the replacement happen. | (defn- tweak-expression
[query stage-number target replacement]
(let [unmodified-query query
replacement (->> replacement
(with-default-name target)
(typed-expression query stage-number))]
(loop [query (lib.util/update-query-stage query stage-number local-replace target replacement)
stage-number stage-number]
(if-let [next-stage-number (lib.util/next-stage-number query stage-number)]
(let [next-replacements (->> (replaced-columns unmodified-query stage-number query)
(mapcat #(next-stage-replacement query next-stage-number %)))]
(recur (reduce (fn [query [target replacement]]
(lib.util/update-query-stage query next-stage-number local-replace target replacement))
query
next-replacements)
next-stage-number))
query)))) |
(defn- prefix
[part whole]
(when (every? true? (map = part whole))
part)) | |
Given a Malli | (defn- on-stage-path
[query error]
(let [in (:in error)]
;; We can only fix problems in stages.
(when (= (first in) :stages)
(let [stage-number (second in)
path-in-stage (nnext in)]
;; The path should point at least to a top level clause in the stage,
;; e.g., a specific expression or an order-by clause, and
;; it should have a stage-path as its prefix.
(when-let [p (and (next path-in-stage)
(some #(prefix % path-in-stage) (stage-paths query stage-number)))]
;; We keep the prefix of `in` that's pointing to a specific element on the stage path.
;; 2 accounts for [:stages stage-number] and 1 for the key of the element on the path.
(subvec in 0 (+ (count p) 2 1))))))) |
(mu/defn ^:private replace-expression-removing-erroneous-parts :- :metabase.lib.schema/query
[unmodified-query :- :metabase.lib.schema/query
stage-number :- :int
target :- :metabase.lib.schema.expression/expression
replacement :- :metabase.lib.schema.expression/expression]
(mu/disable-enforcement
(loop [query (tweak-expression unmodified-query stage-number target replacement)]
(let [explanation (mc/explain :metabase.lib.schema/query query)
error-paths (->> (:errors explanation)
(keep #(on-stage-path query %))
distinct)]
(if (seq error-paths)
(recur (reduce (fn [q path]
(try
(remove-clause q (second path) (get-in q path))
(catch #?(:clj Exception :cljs js/Error) e
(let [{:keys [error join]} (ex-data e)]
(if (= error :metabase.lib.util/cannot-remove-final-join-condition)
;; remove the dangling join
(remove-join q (second path) join)
(throw e))))))
query
error-paths))
(if explanation
;; there is an error we cannot fix, fall back to old way,
;; i.e., remove all dependent parts
(remove-replace* unmodified-query stage-number target :replace replacement)
query)))))) | |
(declare replace-join) | |
(mu/defn replace-clause :- :metabase.lib.schema/query
"Replaces the `target-clause` with `new-clause` in the `query` stage specified by `stage-number`.
If `stage-number` is not specified, the last stage is used."
([query :- :metabase.lib.schema/query
target-clause
new-clause]
(replace-clause query -1 target-clause new-clause))
([query :- :metabase.lib.schema/query
stage-number :- :int
target-clause
new-clause]
(cond
(and (map? target-clause) (= (:lib/type target-clause) :mbql/join))
(replace-join query stage-number target-clause new-clause)
(expression-replacement? target-clause new-clause)
(replace-expression-removing-erroneous-parts query stage-number target-clause new-clause)
:else
(remove-replace* query stage-number target-clause :replace new-clause)))) | |
(defn- field-clause-with-join-alias?
[field-clause join-alias]
(and (lib.util/field-clause? field-clause)
(= (lib.join.util/current-join-alias field-clause) join-alias))) | |
(defn- replace-join-alias
[a-join old-name new-name]
(mbql.match/replace a-join
(field :guard #(field-clause-with-join-alias? % old-name))
(lib.join/with-join-alias field new-name))) | |
(defn- rename-join-in-stage
[stage idx new-name]
(let [the-joins (:joins stage)
[idx old-name] (when (< -1 idx (count the-joins))
[idx (get-in the-joins [idx :alias])])]
(if (and idx (not= old-name new-name))
(let [unique-name-fn (lib.util/unique-name-generator)
_ (run! unique-name-fn (map :alias the-joins))
unique-name (unique-name-fn new-name)]
(-> stage
(assoc-in [:joins idx :alias] unique-name)
(replace-join-alias old-name unique-name)))
stage))) | |
(defn- join-spec->clause
[query stage-number join-spec]
(if (integer? join-spec)
join-spec
(let [pred (cond-> #{join-spec}
(string? join-spec) (comp :alias))]
(some (fn [[idx a-join]]
(when (pred a-join)
idx))
(m/indexed (:joins (lib.util/query-stage query stage-number))))))) | |
(mu/defn rename-join :- :metabase.lib.schema/query
"Rename the join specified by `join-spec` in `query` at `stage-number` to `new-name`.
The join can be specified either by itself (as returned by [[joins]]), by its alias
or by its index in the list of joins as returned by [[joins]].
If `stage-number` is not provided, the last stage is used.
If the specified join cannot be found, then `query` is returned as is.
If renaming the join to `new-name` would clash with an existing join, a
suffix is appended to `new-name` to make it unique."
([query join-spec new-name]
(rename-join query -1 join-spec new-name))
([query :- :metabase.lib.schema/query
stage-number :- :int
join-spec :- [:or :metabase.lib.schema.join/join :string :int]
new-name :- :metabase.lib.schema.common/non-blank-string]
(if-let [idx (join-spec->clause query stage-number join-spec)]
(lib.util/update-query-stage query stage-number rename-join-in-stage idx new-name)
query))) | |
(defn- remove-matching-missing-columns
[query-after query-before stage-number match-spec]
(let [removed-cols (set/difference
(set (lib.metadata.calculation/visible-columns query-before stage-number (lib.util/query-stage query-before stage-number)))
(set (lib.metadata.calculation/visible-columns query-after stage-number (lib.util/query-stage query-after stage-number))))]
(reduce
#(apply remove-local-references %1 stage-number query-after (match-spec %2))
query-after
removed-cols))) | |
(defn- remove-invalidated-refs
[query-after query-before stage-number]
(let [query-without-local-refs (remove-matching-missing-columns
query-after
query-before
stage-number
(fn [column] [:field {:join-alias (::lib.join/join-alias column)} (:id column)]))]
;; Because joins can use :all or :none, we cannot just use `remove-local-references` we have to manually look at the next stage as well
(if-let [stage-number (lib.util/next-stage-number query-without-local-refs stage-number)]
(remove-matching-missing-columns
query-without-local-refs
query-before
stage-number
(fn [column] [:field {} (:lib/desired-column-alias column)]))
query-without-local-refs))) | |
(defn- join-spec->alias
[query stage-number join-spec]
(cond
(integer? join-spec) (get-in (lib.util/query-stage query stage-number) [:joins join-spec :alias])
(map? join-spec) (:alias join-spec)
:else join-spec)) | |
(defn- update-joins
([query stage-number join-spec f]
(if-let [join-alias (join-spec->alias query stage-number join-spec)]
(mu/disable-enforcement
(let [query-after (as-> query $q
(lib.util/update-query-stage
$q
stage-number
(fn [stage]
(u/assoc-dissoc stage :joins (f (:joins stage) join-alias))))
(lib.util/update-query-stage
$q
stage-number
(fn [stage]
(m/update-existing
stage
:joins
(fn [joins]
(mapv #(lib.join/add-default-alias $q stage-number %) joins))))))]
(-> query-after
(remove-invalidated-refs query stage-number)
normalize-fields-clauses)))
query))) | |
(defn- has-field-from-join? [form join-alias]
(some? (mbql.match/match-one form
(field :guard #(field-clause-with-join-alias? % join-alias))))) | |
(defn- dependent-join? [join join-alias]
(or (= (:alias join) join-alias)
(has-field-from-join? join join-alias))) | |
(mu/defn remove-join :- :metabase.lib.schema/query
"Remove the join specified by `join-spec` in `query` at `stage-number`.
The join can be specified either by itself (as returned by [[joins]]), by its alias
or by its index in the list of joins as returned by [[joins]].
If `stage-number` is not provided, the last stage is used.
If the specified join cannot be found, then `query` is returned as is.
Top level clauses containing references to the removed join are removed too."
([query join-spec]
(remove-join query -1 join-spec))
([query :- :metabase.lib.schema/query
stage-number :- :int
join-spec :- [:or :metabase.lib.schema.join/join :string :int]]
(try
(update-joins query stage-number join-spec (fn [joins join-alias]
(not-empty (filterv #(not (dependent-join? % join-alias))
joins))))
(catch #?(:clj Exception :cljs :default) e
(let [{:keys [error join] error-stage-number :stage-number} (ex-data e)]
(if (= error ::lib.util/cannot-remove-final-join-condition)
(-> query
(remove-join error-stage-number join)
(remove-join stage-number join-spec))
(throw e))))))) | |
(mu/defn replace-join :- :metabase.lib.schema/query
"Replace the join specified by `join-spec` in `query` at `stage-number` with `new-join`.
If `new-join` is nil, the join is removed as if by [[remove-join]].
The join can be specified either by itself (as returned by [[joins]]), by its alias
or by its index in the list of joins as returned by [[joins]].
If `stage-number` is not provided, the last stage is used.
If the specified join cannot be found, then `query` is returned as is.
Top level clauses containing references to the removed join are removed too."
([query join-spec new-join]
(replace-join query -1 join-spec new-join))
([query :- :metabase.lib.schema/query
stage-number :- :int
join-spec :- [:or :metabase.lib.schema.join/join :string :int]
new-join]
(if (nil? new-join)
(remove-join query stage-number join-spec)
(update-joins query stage-number join-spec (fn [joins join-alias]
(mapv #(if (= (:alias %) join-alias)
new-join
%)
joins)))))) | |
(defn- specifies-default-fields? [query stage-number]
(let [fields (:fields (lib.util/query-stage query stage-number))]
(and fields
;; Quick first check: if there are any implicitly-joined fields, it's not the default list.
(not (some (comp :source-field lib.options/options) fields))
(lib.equality/matching-column-sets? query stage-number fields
(lib.metadata.calculation/default-columns-for-stage query stage-number))))) | |
(defn- normalize-fields-for-join [query stage-number join]
(if (#{:none :all} (:fields join))
;; Nothing to do if it's already a keyword.
join
(cond-> join
(lib.equality/matching-column-sets?
query stage-number (:fields join)
(lib.metadata.calculation/returned-columns query stage-number (assoc join :fields :all)))
(assoc :fields :all)))) | |
(defn- normalize-fields-for-stage [query stage-number]
(let [stage (lib.util/query-stage query stage-number)]
(cond-> query
(specifies-default-fields? query stage-number)
(lib.util/update-query-stage stage-number dissoc :fields)
(:joins stage)
(lib.util/update-query-stage stage-number update :joins
(partial mapv #(normalize-fields-for-join query stage-number %)))))) | |
(mu/defn normalize-fields-clauses :- :metabase.lib.schema/query "Check all the `:fields` clauses in the query - on the stages and any joins - and drops them if they are equal to the defaults. - For stages, if the `:fields` list is identical to the default fields for this stage. - For joins, replace it with `:all` if it's all the fields that are in the join by default. - For joins, remove it if the list is empty (the default for joins is no fields)." [query :- :metabase.lib.schema/query] (reduce normalize-fields-for-stage query (range (count (:stages query))))) | |
Malli schema for the pMBQL query type, the version of MBQL produced and manipulated by the new Cljc Metabase lib. Currently this is a little different from the version of MBQL consumed by the QP, specified in [[metabase.mbql.schema]]. Hopefully these versions will converge in the future. Some primitives below are duplicated from [[metabase.util.malli.schema]] since that's not | (ns metabase.lib.schema (:refer-clojure :exclude [ref]) (:require [metabase.lib.schema.aggregation :as aggregation] [metabase.lib.schema.common :as common] [metabase.lib.schema.expression :as expression] [metabase.lib.schema.expression.arithmetic] [metabase.lib.schema.expression.conditional] [metabase.lib.schema.expression.string] [metabase.lib.schema.expression.temporal] [metabase.lib.schema.filter] [metabase.lib.schema.id :as id] [metabase.lib.schema.join :as join] [metabase.lib.schema.literal] [metabase.lib.schema.order-by :as order-by] [metabase.lib.schema.ref :as ref] [metabase.lib.schema.template-tag :as template-tag] [metabase.lib.schema.util :as lib.schema.util] [metabase.mbql.util :as mbql.u] [metabase.mbql.util.match :as mbql.match] [metabase.util.malli.registry :as mr])) |
(comment metabase.lib.schema.expression.arithmetic/keep-me
metabase.lib.schema.expression.conditional/keep-me
metabase.lib.schema.expression.string/keep-me
metabase.lib.schema.expression.temporal/keep-me
metabase.lib.schema.filter/keep-me
metabase.lib.schema.literal/keep-me) | |
(mr/def ::stage.native
[:map
[:lib/type [:= :mbql.stage/native]]
;; the actual native query, depends on the underlying database. Could be a raw SQL string or something like that.
;; Only restriction is that it is non-nil.
[:native some?]
;; any parameters that should be passed in along with the query to the underlying query engine, e.g. for JDBC these
;; are the parameters we pass in for a `PreparedStatement` for `?` placeholders. These can be anything, including
;; nil.
[:args {:optional true} [:sequential any?]]
;; the Table/Collection/etc. that this query should be executed against; currently only used for MongoDB, where it
;; is required.
[:collection {:optional true} ::common/non-blank-string]
;; optional template tag declarations. Template tags are things like `{{x}}` in the query (the value of the
;; `:native` key), but their definition lives under this key.
[:template-tags {:optional true} [:ref ::template-tag/template-tag-map]]]) | |
(mr/def ::breakout [:ref ::ref/ref]) | |
(mr/def ::breakouts
[:and
[:sequential {:min 1} ::breakout]
[:fn
{:error/message "Breakouts must be distinct"}
#'lib.schema.util/distinct-refs?]]) | |
(mr/def ::fields
[:and
[:sequential {:min 1} [:ref ::ref/ref]]
[:fn
{:error/message ":fields must be distinct"}
#'lib.schema.util/distinct-refs?]]) | |
this is just for enabling round-tripping filters with named segment references | (mr/def ::filterable [:or [:ref ::expression/boolean] [:tuple [:= :segment] :map :string]]) |
(mr/def ::filters
[:sequential {:min 1} ::filterable]) | |
(defn- bad-ref-clause? [ref-type valid-ids x]
(and (vector? x)
(= ref-type (first x))
(not (contains? valid-ids (get x 2))))) | |
(defn- expression-ref-errors-for-stage [stage]
(let [expression-names (into #{} (map (comp :lib/expression-name second)) (:expressions stage))]
(mbql.u/matching-locations (dissoc stage :joins :lib/stage-metadata)
#(bad-ref-clause? :expression expression-names %)))) | |
(defn- aggregation-ref-errors-for-stage [stage]
(let [uuids (into #{} (map (comp :lib/uuid second)) (:aggregation stage))]
(mbql.u/matching-locations (dissoc stage :joins :lib/stage-metadata)
#(bad-ref-clause? :aggregation uuids %)))) | |
Return the locations and the clauses with dangling expression or aggregation references. The return value is sequence of pairs (vectors) with the first element specifying the location as a vector usable in [[get-in]] and the second element being the clause with dangling reference. | (defn ref-errors-for-stage
[stage]
(concat (expression-ref-errors-for-stage stage)
(aggregation-ref-errors-for-stage stage))) |
(defn- expression-ref-error-for-stage [stage]
(when-let [err-loc (first (expression-ref-errors-for-stage stage))]
(if-let [expression-name (get-in err-loc [1 2])]
(str "Invalid :expression reference: no expression named " (pr-str expression-name))
(str "Invalid :expression reference: " (get err-loc 1))))) | |
(defn- aggregation-ref-error-for-stage [stage]
(when-let [err-loc (first (aggregation-ref-errors-for-stage stage))]
(if-let [ag-uuid (get-in err-loc [1 2])]
(str "Invalid :aggregation reference: no aggregation with uuid " ag-uuid)
(str "Invalid :aggregation reference: " (get err-loc 1))))) | |
Validate references in the context of a single | (def ^:private ^{:arglists '([stage])} ref-error-for-stage
(some-fn expression-ref-error-for-stage
aggregation-ref-error-for-stage)) |
(mr/def ::stage.valid-refs
[:fn
{:error/message "Valid references for a single query stage"
:error/fn (fn [{:keys [value]} _]
(ref-error-for-stage value))}
(complement ref-error-for-stage)]) | |
(mr/def ::stage.mbql
[:and
[:map
[:lib/type [:= :mbql.stage/mbql]]
[:joins {:optional true} [:ref ::join/joins]]
[:expressions {:optional true} [:ref ::expression/expressions]]
[:breakout {:optional true} ::breakouts]
[:aggregation {:optional true} [:ref ::aggregation/aggregations]]
[:fields {:optional true} ::fields]
[:filters {:optional true} ::filters]
[:order-by {:optional true} [:ref ::order-by/order-bys]]
[:source-table {:optional true} [:ref ::id/table]]
[:source-card {:optional true} [:ref ::id/card]]
;; TODO -- `:page` ???
]
[:fn
{:error/message ":source-query is not allowed in pMBQL queries."}
#(not (contains? % :source-query))]
[:fn
{:error/message "A query cannot have both a :source-table and a :source-card."}
(complement (every-pred :source-table :source-card))]
[:ref ::stage.valid-refs]]) | |
Schema for an MBQL stage that includes either | (mr/def ::stage.mbql.with-source-table
[:merge
[:ref ::stage.mbql]
[:map
[:source-table [:ref ::id/table]]]]) |
(mr/def ::stage.mbql.with-source-card
[:merge
[:ref ::stage.mbql]
[:map
[:source-card [:ref ::id/card]]]]) | |
(mr/def ::stage.mbql.with-source [:or [:ref ::stage.mbql.with-source-table] [:ref ::stage.mbql.with-source-card]]) | |
Schema for an MBQL stage that DOES NOT include | (mr/def ::stage.mbql.without-source
[:and
[:ref ::stage.mbql]
[:fn
{:error/message "Only the initial stage of a query can have a :source-table or :source-card."}
(complement (some-fn :source-table :source-card))]]) |
the schemas are constructed this way instead of using | (mr/def ::stage.type [:enum :mbql.stage/native :mbql.stage/mbql]) |
(mr/def ::stage
[:and
[:map
[:lib/type ::stage.type]]
[:multi {:dispatch :lib/type}
[:mbql.stage/native [:ref ::stage.native]]
[:mbql.stage/mbql [:ref ::stage.mbql]]]]) | |
(mr/def ::stage.initial
[:and
[:map
[:lib/type ::stage.type]]
[:multi {:dispatch :lib/type}
[:mbql.stage/native [:ref ::stage.native]]
[:mbql.stage/mbql [:ref ::stage.mbql.with-source]]]]) | |
(mr/def ::stage.additional ::stage.mbql.without-source) | |
Apparently you're allowed to use a join alias for a join that appeared in any previous stage or the current stage, or inside any join in any previous stage or the current stage. Why? Who knows, but this is a real thing. See [[metabase.driver.sql.query-processor-test/join-source-queries-with-joins-test]] for example. This doesn't really make sense IMO (you should use string field refs to refer to things from a previous stage...right?) but for now we'll have to allow it until we can figure out how to go fix all of the old broken queries. Also, it's apparently legal to use a join alias to refer to a column that comes from a join in a source Card, and there is no way for us to know what joins exist in the source Card without a metadata provider, so we're just going to have to go ahead and skip validation in that case. Icky! But it's better than being overly strict and rejecting queries that the QP could have fixed. Anyways, this function returns a function with the signature: (visible-join-alias? | (defn- visible-join-alias?-fn
[stage]
(if (:source-card stage)
(constantly true)
(letfn [(join-aliases-in-join [join]
(cons
(:alias join)
(mapcat join-aliases-in-stage (:stages join))))
(join-aliases-in-stage [stage]
(mapcat join-aliases-in-join (:joins stage)))]
(set (join-aliases-in-stage stage))))) |
(defn- join-ref-error-for-stages [stages]
(when (sequential? stages)
(loop [visible-join-alias? (constantly false), i 0, [stage & more] stages]
(let [visible-join-alias? (some-fn visible-join-alias? (visible-join-alias?-fn stage))]
(or
(mbql.match/match-one (dissoc stage :joins :stage/metadata) ; TODO isn't this supposed to be `:lib/stage-metadata`?
[:field ({:join-alias (join-alias :guard (complement visible-join-alias?))} :guard :join-alias) _id-or-name]
(str "Invalid :field reference in stage " i ": no join named " (pr-str join-alias)))
(when (seq more)
(recur visible-join-alias? (inc i) more))))))) | |
Like [[ref-error-for-stage]], but validate references in the context of a sequence of several stages; for validations that can't be done on the basis of just a single stage. For example join alias validation needs to take into account previous stages. | (def ^:private ^{:arglists '([stages])} ref-error-for-stages
;; this var is ultimately redundant for now since it just points to one function but I'm leaving it here so we can
;; add more stuff to it the future as we validate more things.
join-ref-error-for-stages) |
(mr/def ::stages.valid-refs
[:fn
{:error/message "Valid references for all query stages"
:error/fn (fn [{:keys [value]} _]
(ref-error-for-stages value))}
(complement ref-error-for-stages)]) | |
(mr/def ::stages
[:and
[:cat
[:schema [:ref ::stage.initial]]
[:* [:schema [:ref ::stage.additional]]]]
[:ref ::stages.valid-refs]]) | |
(mr/def ::query
[:and
[:map
[:lib/type [:= :mbql/query]]
[:database [:or
::id/database
::id/saved-questions-virtual-database]]
[:stages [:ref ::stages]]]
lib.schema.util/UniqueUUIDs]) | |
(ns metabase.lib.schema.aggregation (:require [metabase.lib.hierarchy :as lib.hierarchy] [metabase.lib.schema.expression :as expression] [metabase.lib.schema.mbql-clause :as mbql-clause] [metabase.shared.util.i18n :as i18n] [metabase.util.malli.registry :as mr])) | |
count has an optional expression arg. This is the number of non-NULL values -- corresponds to count( | (mbql-clause/define-catn-mbql-clause :count :- :type/Integer [:expression [:? [:schema [:ref ::expression/expression]]]]) |
cum-count has an optional expression arg | (mbql-clause/define-catn-mbql-clause :cum-count :- :type/Integer [:expression [:? [:schema [:ref ::expression/expression]]]]) |
(mbql-clause/define-tuple-mbql-clause :avg :- :type/Float [:schema [:ref ::expression/number]]) | |
number of distinct values of something. | (mbql-clause/define-tuple-mbql-clause :distinct :- :type/Integer [:schema [:ref ::expression/expression]]) |
(mbql-clause/define-tuple-mbql-clause :count-where :- :type/Integer [:schema [:ref ::expression/boolean]]) | |
min and max should work on anything orderable, including numbers, temporal values, and even text values. | (mbql-clause/define-tuple-mbql-clause :max [:schema [:ref ::expression/orderable]]) |
(lib.hierarchy/derive :max :lib.type-of/type-is-type-of-first-arg) | |
apparently median and percentile only work for numeric args in Postgres, as opposed to anything orderable. Not sure this makes sense conceptually, but since there probably isn't as much of a use case we can keep that restriction in MBQL for now. | (mbql-clause/define-tuple-mbql-clause :median [:schema [:ref ::expression/number]]) |
(lib.hierarchy/derive :median :lib.type-of/type-is-type-of-first-arg) | |
(mbql-clause/define-tuple-mbql-clause :min [:schema [:ref ::expression/orderable]]) | |
(lib.hierarchy/derive :min :lib.type-of/type-is-type-of-first-arg) | |
(mr/def ::percentile.percentile
[:and
{:error/message "valid percentile"}
[:ref ::expression/number]
[:fn
{:error/message "percentile must be between zero and one"}
#(<= 0 % 1)]]) | |
(mbql-clause/define-tuple-mbql-clause :percentile #_expr [:ref ::expression/number] #_percentile [:ref ::percentile.percentile]) | |
(lib.hierarchy/derive :percentile :lib.type-of/type-is-type-of-first-arg) | |
(mbql-clause/define-tuple-mbql-clause :share :- :type/Float [:schema [:ref ::expression/boolean]]) | |
(mbql-clause/define-tuple-mbql-clause :stddev :- :type/Float [:schema [:ref ::expression/number]]) | |
(mbql-clause/define-tuple-mbql-clause :sum [:schema [:ref ::expression/number]]) | |
(mbql-clause/define-tuple-mbql-clause :cum-sum [:schema [:ref ::expression/number]]) | |
(lib.hierarchy/derive :sum :lib.type-of/type-is-type-of-first-arg) | |
(lib.hierarchy/derive :cum-sum :lib.type-of/type-is-type-of-first-arg) | |
(mbql-clause/define-tuple-mbql-clause :sum-where [:schema [:ref ::expression/number]] [:schema [:ref ::expression/boolean]]) | |
(lib.hierarchy/derive :sum-where :lib.type-of/type-is-type-of-first-arg) | |
(mbql-clause/define-tuple-mbql-clause :var :- :type/Float #_expr [:schema [:ref ::expression/number]]) | |
(mr/def ::aggregation ;; placeholder! [:or :mbql.clause/avg :mbql.clause/count :mbql.clause/cum-count :mbql.clause/count-where :mbql.clause/distinct :mbql.clause/max :mbql.clause/median :mbql.clause/min :mbql.clause/percentile :mbql.clause/share :mbql.clause/stddev :mbql.clause/sum :mbql.clause/cum-sum :mbql.clause/sum-where :mbql.clause/var any?]) | |
(mr/def ::aggregations
[:sequential {:min 1} [:ref ::aggregation]]) | |
The list of available aggregation operator. The order of operators is relevant for the front end. | (def aggregation-operators
[{:short :count
:requires-column? false
:driver-feature :basic-aggregations
:display-info (fn []
{:display-name (i18n/tru "Count of rows")
:column-name (i18n/tru "Count")
:description (i18n/tru "Total number of rows in the answer.")})}
{:short :sum
:supported-field :metabase.lib.types.constants/summable
:requires-column? true
:driver-feature :basic-aggregations
:display-info (fn []
{:display-name (i18n/tru "Sum of ...")
:column-name (i18n/tru "Sum")
:description (i18n/tru "Sum of all the values of a column.")})}
{:short :avg
:supported-field :metabase.lib.types.constants/summable
:requires-column? true
:driver-feature :basic-aggregations
:display-info (fn []
{:display-name (i18n/tru "Average of ...")
:column-name (i18n/tru "Average")
:description (i18n/tru "Average of all the values of a column")})}
{:short :median
:supported-field :metabase.lib.types.constants/summable
:requires-column? true
:driver-feature :percentile-aggregations
:display-info (fn []
{:display-name (i18n/tru "Median of ...")
:column-name (i18n/tru "Median")
:description (i18n/tru "Median of all the values of a column")})}
{:short :distinct
:supported-field :any
:requires-column? true
:driver-feature :basic-aggregations
:display-info (fn []
{:display-name (i18n/tru "Number of distinct values of ...")
:column-name (i18n/tru "Distinct values")
:description (i18n/tru "Number of unique values of a column among all the rows in the answer.")})}
{:short :cum-sum
:supported-field :metabase.lib.types.constants/summable
:requires-column? true
:driver-feature :basic-aggregations
:display-info (fn []
{:display-name (i18n/tru "Cumulative sum of ...")
:column-name (i18n/tru "Sum")
:description (i18n/tru "Additive sum of all the values of a column.\ne.x. total revenue over time.")})}
{:short :cum-count
:requires-column? false
:driver-feature :basic-aggregations
:display-info (fn []
{:display-name (i18n/tru "Cumulative count of rows")
:column-name (i18n/tru "Count")
:description (i18n/tru "Additive count of the number of rows.\ne.x. total number of sales over time.")})}
{:short :stddev
:supported-field :metabase.lib.types.constants/summable
:requires-column? true
:driver-feature :standard-deviation-aggregations
:display-info (fn []
{:display-name (i18n/tru "Standard deviation of ...")
:column-name (i18n/tru "SD")
:description (i18n/tru "Number which expresses how much the values of a column vary among all rows in the answer.")})}
{:short :min
:supported-field :metabase.lib.types.constants/scope
:requires-column? true
:driver-feature :basic-aggregations
:display-info (fn []
{:display-name (i18n/tru "Minimum of ...")
:column-name (i18n/tru "Min")
:description (i18n/tru "Minimum value of a column")})}
{:short :max
:supported-field :metabase.lib.types.constants/scope
:requires-column? true
:driver-feature :basic-aggregations
:display-info (fn []
{:display-name (i18n/tru "Maximum of ...")
:column-name (i18n/tru "Max")
:description (i18n/tru "Maximum value of a column")})}]) |
(mr/def ::operator
[:map
[:lib/type [:= :operator/aggregation]]
[:short (into [:enum] (map :short) aggregation-operators)]
[:supported-field {:optional true} [:maybe :keyword]] ; TODO more precise type?
[:requires-column? :boolean]
[:driver-feature :keyword] ; TODO more precise type?
[:display-info fn?]]) | |
Malli schema for binning of a column's values. There are two approaches to binning, selected by | (ns metabase.lib.schema.binning (:require [metabase.lib.schema.common :as lib.schema.common] [metabase.util.malli.registry :as mr])) |
(mr/def ::strategy [:enum :bin-width :default :num-bins]) | |
(mr/def ::num-bins ::lib.schema.common/positive-int) | |
(mr/def ::bin-width ::lib.schema.common/positive-number) | |
(mr/def ::binning
[:merge
[:map
[:strategy [:ref ::strategy]]]
[:multi {:dispatch :strategy
:error/fn (fn [{:keys [value]} _]
(str "Invalid binning strategy" (pr-str value)))}
[:default :map]
[:bin-width [:map
[:bin-width [:ref ::bin-width]]]]
[:num-bins [:map
[:num-bins [:ref ::num-bins]]]]]]) | |
(mr/def ::binning-option
[:map
[:lib/type [:= :option/binning]]
[:display-name :string]
[:mbql [:maybe ::binning]]
[:default {:optional true} :boolean]]) | |
(ns metabase.lib.schema.common (:require [clojure.string :as str] [metabase.types] [metabase.util.malli.registry :as mr])) | |
(comment metabase.types/keep-me) | |
Schema for a string that cannot be blank. | (mr/def ::non-blank-string
[:and
[:string {:min 1}]
[:fn
{:error/message "non-blank string"}
(complement str/blank?)]]) |
Schema representing an integer than must also be greater than or equal to zero. | (mr/def ::int-greater-than-or-equal-to-zero
[:int {:min 0}]) |
(mr/def ::positive-int pos-int?) | |
(mr/def ::positive-number
[:fn
{:error/message "positive number"}
(every-pred number? pos?)]) | |
(mr/def ::uuid
;; TODO -- should this be stricter?
[:string {:min 36, :max 36}]) | |
(defn- semantic-type? [x] (isa? x :Semantic/*)) | |
(mr/def ::semantic-type
[:fn
{:error/message "valid semantic type"
:error/fn (fn [{:keys [value]} _]
(str "Not a valid semantic type: " (pr-str value)))}
semantic-type?]) | |
(defn- relation-type? [x] (isa? x :Relation/*)) | |
(mr/def ::relation-type
[:fn
{:error/message "valid relation type"
:error/fn (fn [{:keys [value]} _]
(str "Not a valid relation type: " (pr-str value)))}
relation-type?]) | |
(mr/def ::semantic-or-relation-type [:or [:ref ::semantic-type] [:ref ::relation-type]]) | |
(defn- base-type? [x] (isa? x :type/*)) | |
(mr/def ::base-type
[:fn
{:error/message "valid base type"
:error/fn (fn [{:keys [value]} _]
(str "Not a valid base type: " (pr-str value)))}
base-type?]) | |
(mr/def ::options
[:map
[:lib/uuid ::uuid]
;; these options aren't required for any clause in particular, but if they're present they must follow these schemas.
[:base-type {:optional true} [:maybe ::base-type]]
[:effective-type {:optional true} [:maybe ::base-type]]
;; these two different types are currently both stored under one key, but maybe one day we can fix this.
[:semantic-type {:optional true} [:maybe ::semantic-or-relation-type]]
[:database-type {:optional true} [:maybe ::non-blank-string]]
[:name {:optional true} [:maybe ::non-blank-string]]
[:display-name {:optional true} [:maybe ::non-blank-string]]]) | |
(mr/def ::external-op
[:map
[:lib/type [:= :lib/external-op]]
[:operator [:or :string :keyword]]
[:args [:sequential :any]]
[:options {:optional true} ::options]]) | |
Malli schemas for possible drill-thru operations. Drill-thrus are not part of MBQL; they are a set of actions one can take to transform a query.
For example, adding a filter like | (ns metabase.lib.schema.drill-thru
(:require
[metabase.lib.schema :as-alias lib.schema]
[metabase.lib.schema.binning :as lib.schema.binning]
[metabase.lib.schema.common :as lib.schema.common]
[metabase.lib.schema.expression :as lib.schema.expression]
[metabase.lib.schema.filter :as lib.schema.filter]
[metabase.lib.schema.id :as lib.schema.id]
[metabase.lib.schema.metadata :as lib.schema.metadata]
[metabase.lib.schema.order-by :as lib.schema.order-by]
[metabase.lib.schema.ref :as lib.schema.ref]
[metabase.lib.schema.temporal-bucketing
:as lib.schema.temporal-bucketing]
[metabase.util.malli.registry :as mr])) |
(mr/def ::pivot-types [:enum :category :location :time]) | |
(mr/def ::drill-thru.type
[:fn
{:error/message "valid drill-thru :type keyword"}
(fn [k]
(and (qualified-keyword? k)
(= (namespace k) "drill-thru")))]) | |
(mr/def ::drill-thru.common [:map [:type ::drill-thru.type] [:lib/type [:= :metabase.lib.drill-thru/drill-thru]]]) | |
A drill thru that contains a column | (mr/def ::drill-thru.common.with-column
[:merge
::drill-thru.common
[:map
[:column [:ref ::lib.schema.metadata/column]]]]) |
there are three "object details" drills: | |
(mr/def ::drill-thru.object-details.dimension
[:map
[:column [:ref ::lib.schema.metadata/column]]
;; we should ignore NULL values for PKs and FKs -- do not add filters on them.
[:value [:and
:some
[:fn {:error/message "Non-NULL value"} #(not= % :null)]]]]) | |
(mr/def ::drill-thru.object-details.dimensions
[:sequential {:min 1} [:ref ::drill-thru.object-details.dimension]]) | |
(mr/def ::drill-thru.pk
[:merge
::drill-thru.common
[:map
[:type [:= :drill-thru/pk]]
[:dimensions [:ref ::drill-thru.object-details.dimensions]]]]) | |
(mr/def ::drill-thru.fk-details.fk-column
[:merge
[:ref ::lib.schema.metadata/column]
[:map
[:fk-target-field-id ::lib.schema.id/field]]]) | |
(mr/def ::drill-thru.fk-details
[:merge
::drill-thru.common.with-column
[:map
[:type [:= :drill-thru/fk-details]]
[:column [:ref ::drill-thru.fk-details.fk-column]]
[:object-id :any]
[:many-pks? :boolean]]]) | |
(mr/def ::drill-thru.zoom
[:merge
::drill-thru.common.with-column
[:map
[:type [:= :drill-thru/zoom]]
[:object-id :any]
;; TODO -- I don't think we really need this because there is no situation in which this isn't `false`, if it were
;; true we'd return a `::drill-thru.pk` drill instead. See if we can remove this key without breaking the FE.
[:many-pks? [:= false]]]]) | |
(mr/def ::drill-thru.quick-filter.operator [:map [:name ::lib.schema.common/non-blank-string] [:filter [:ref ::lib.schema.expression/boolean]]]) | |
(mr/def ::drill-thru.quick-filter
[:merge
::drill-thru.common
[:map
[:type [:= :drill-thru/quick-filter]]
[:operators [:sequential ::drill-thru.quick-filter.operator]]
[:column [:ref ::lib.schema.metadata/column]]
[:value [:maybe :any]]
[:query [:ref ::lib.schema/query]]
[:stage-number number?]]]) | |
(mr/def ::drill-thru.fk-filter
[:merge
::drill-thru.common
[:map
[:type [:= :drill-thru/fk-filter]]
[:filter ::lib.schema.expression/boolean]
[:table-name :string]
[:column-name :string]]]) | |
(mr/def ::drill-thru.distribution
[:merge
::drill-thru.common.with-column
[:map
[:type [:= :drill-thru/distribution]]]]) | |
(mr/def ::drill-thru.pivot
[:merge
::drill-thru.common
[:map
[:type [:= :drill-thru/pivot]]
[:pivots [:map-of ::pivot-types [:sequential [:ref ::lib.schema.metadata/column]]]]]]) | |
(mr/def ::drill-thru.sort
[:merge
::drill-thru.common
[:map
[:type [:= :drill-thru/sort]]
[:sort-directions [:sequential ::lib.schema.order-by/direction]]]]) | |
(mr/def ::drill-thru.summarize-column.aggregation-type [:enum :avg :distinct :sum]) | |
(mr/def ::drill-thru.summarize-column
[:merge
::drill-thru.common.with-column
[:map
[:type [:= :drill-thru/summarize-column]]
[:aggregations [:sequential [:ref ::drill-thru.summarize-column.aggregation-type]]]]]) | |
(mr/def ::drill-thru.summarize-column-by-time
[:merge
::drill-thru.common.with-column
[:map
[:type [:= :drill-thru/summarize-column-by-time]]
[:breakout [:ref ::lib.schema.metadata/column]]
[:unit ::lib.schema.temporal-bucketing/unit]]]) | |
(mr/def ::drill-thru.column-filter
[:merge
::drill-thru.common.with-column
[:map
[:type [:= :drill-thru/column-filter]]
[:initial-op [:maybe ::lib.schema.filter/operator]]
[:column [:ref ::lib.schema.metadata/column]]
[:query [:ref ::lib.schema/query]]
[:stage-number number?]]]) | |
TODO FIXME -- it seems like underlying records drills also include | (mr/def ::drill-thru.underlying-records
[:merge
::drill-thru.common
[:map
[:type [:= :drill-thru/underlying-records]]
[:row-count number?]
[:table-name [:maybe string?]]]]) |
(mr/def ::drill-thru.automatic-insights
[:merge
::drill-thru.common
[:map
[:type [:= :drill-thru/automatic-insights]]
[:lib/type [:= :metabase.lib.drill-thru/drill-thru]]
[:column-ref [:maybe [:ref ::lib.schema.ref/ref]]]
[:dimensions [:ref ::context.row]]]]) | |
(mr/def ::drill-thru.zoom-in.timeseries.next-unit [:enum :quarter :month :week :day :hour :minute]) | |
(mr/def ::drill-thru.zoom-in.timeseries
[:merge
::drill-thru.common
[:map
[:type [:= :drill-thru/zoom-in.timeseries]]
[:dimension [:ref ::context.row.value]]
[:next-unit [:ref ::drill-thru.zoom-in.timeseries.next-unit]]]]) | |
(mr/def ::drill-thru.zoom-in.geographic.column.latitude
[:merge
[:ref ::lib.schema.metadata/column]
[:map
[:semantic-type [:fn
{:error/message "Latitude semantic type"}
#(isa? % :type/Latitude)]]]]) | |
(mr/def ::drill-thru.zoom-in.geographic.column.longitude
[:merge
[:ref ::lib.schema.metadata/column]
[:map
[:semantic-type [:fn
{:error/message "Longitude semantic type"}
#(isa? % :type/Longitude)]]]]) | |
(mr/def ::drill-thru.zoom-in.geographic.column.county-state-city
[:merge
[:ref ::lib.schema.metadata/column]
[:map
[:semantic-type [:fn
{:error/message "Country/State/City semantic type"}
#(some (fn [semantic-type]
(isa? % semantic-type))
[:type/Country :type/State :type/City])]]]]) | |
(mr/def ::drill-thru.zoom-in.geographic.country-state-city->binned-lat-lon
[:merge
::drill-thru.common
[:map
[:type [:= :drill-thru/zoom-in.geographic]]
[:subtype [:= :drill-thru.zoom-in.geographic/country-state-city->binned-lat-lon]]
[:column ::drill-thru.zoom-in.geographic.column.county-state-city]
[:value some?]
[:latitude [:map
[:column [:ref ::drill-thru.zoom-in.geographic.column.latitude]]
[:bin-width [:ref ::lib.schema.binning/bin-width]]]]
[:longitude [:map
[:column [:ref ::drill-thru.zoom-in.geographic.column.longitude]]
[:bin-width [:ref ::lib.schema.binning/bin-width]]]]]]) | |
(mr/def ::drill-thru.zoom-in.geographic.binned-lat-lon->binned-lat-lon
[:merge
::drill-thru.common
[:map
[:type [:= :drill-thru/zoom-in.geographic]]
[:subtype [:= :drill-thru.zoom-in.geographic/binned-lat-lon->binned-lat-lon]]
[:latitude [:map
[:column [:ref ::drill-thru.zoom-in.geographic.column.latitude]]
[:bin-width [:ref ::lib.schema.binning/bin-width]]
[:min number?]
[:max number?]]]
[:longitude [:map
[:column [:ref ::drill-thru.zoom-in.geographic.column.longitude]]
[:bin-width [:ref ::lib.schema.binning/bin-width]]
[:min number?]
[:max number?]]]]]) | |
(mr/def ::drill-thru.zoom-in.geographic
[:and
[:merge
::drill-thru.common
[:map
[:type [:= :drill-thru/zoom-in.geographic]]
[:subtype keyword?]]]
[:multi {:dispatch :subtype
:error/fn (fn [{:keys [value]} _]
(str "Invalid zoom-in.geographic drill thru subtype" (pr-str value)))}
[:drill-thru.zoom-in.geographic/country-state-city->binned-lat-lon
::drill-thru.zoom-in.geographic.country-state-city->binned-lat-lon]
[:drill-thru.zoom-in.geographic/binned-lat-lon->binned-lat-lon
::drill-thru.zoom-in.geographic.binned-lat-lon->binned-lat-lon]]]) | |
(mr/def ::drill-thru.zoom-in.binning
[:merge
::drill-thru.common.with-column
[:map
[:type [:= :drill-thru/zoom-in.binning]]
[:min-value number?]
[:max-value number?]
[:new-binning ::lib.schema.binning/binning]]]) | |
(mr/def ::drill-thru
[:and
::drill-thru.common
[:multi {:dispatch :type
:error/fn (fn [{:keys [value]} _]
(str "Invalid drill thru (unknown :type): " (pr-str value)))}
[:drill-thru/pk ::drill-thru.pk]
[:drill-thru/fk-details ::drill-thru.fk-details]
[:drill-thru/zoom ::drill-thru.zoom]
[:drill-thru/quick-filter ::drill-thru.quick-filter]
[:drill-thru/fk-filter ::drill-thru.fk-filter]
[:drill-thru/distribution ::drill-thru.distribution]
[:drill-thru/pivot ::drill-thru.pivot]
[:drill-thru/sort ::drill-thru.sort]
[:drill-thru/summarize-column ::drill-thru.summarize-column]
[:drill-thru/summarize-column-by-time ::drill-thru.summarize-column-by-time]
[:drill-thru/column-filter ::drill-thru.column-filter]
[:drill-thru/underlying-records ::drill-thru.underlying-records]
[:drill-thru/automatic-insights ::drill-thru.automatic-insights]
[:drill-thru/zoom-in.timeseries ::drill-thru.zoom-in.timeseries]
[:drill-thru/zoom-in.geographic ::drill-thru.zoom-in.geographic]
[:drill-thru/zoom-in.binning ::drill-thru.zoom-in.binning]]]) | |
Context | |
There are basically 5 shapes that contexts can come in, see this thread https://metaboat.slack.com/archives/C04CYTEL9N2/p1701898192634679 and https://github.com/metabase/metabase/issues/36253 for more info. | Drill Context Shape | column | value | row | dimensions | |---------------------|--------|-------|-----|------------| | Column Header | ✔ | | | | | "Raw" Cell | ✔ | ✔ | ✔ | | | "Aggregated" Cell | ✔ | ✔ | ✔ | ✔ | | Pivot Cell | | ✔ | ✔ | ✔ | | Legend Item | | | | ✔ | | |
(mr/def ::context.row.value
[:map
[:column [:ref ::lib.schema.metadata/column]]
[:column-ref [:ref ::lib.schema.ref/ref]]
[:value [:fn
{:error/message ":null should not be used in context row values, only for top-level context value"}
#(not= % :null)]]]) | |
Sequence of maps with keys These are presumably in the same order as the returned columns for the query stage | (mr/def ::context.row [:sequential [:ref ::context.row.value]]) |
(mr/def ::context
[:map
[:column [:maybe [:ref ::lib.schema.metadata/column]]]
[:column-ref [:maybe [:ref ::lib.schema.ref/ref]]]
[:value [:maybe :any]]
[:row {:optional true} [:ref ::context.row]]
[:dimensions {:optional true} [:maybe [:ref ::context.row]]]]) | |
(ns metabase.lib.schema.expression (:require [metabase.lib.dispatch :as lib.dispatch] [metabase.lib.hierarchy :as lib.hierarchy] [metabase.lib.schema.common :as common] [metabase.shared.util.i18n :as i18n] [metabase.types :as types] [metabase.util :as u] [metabase.util.malli :as mu] [metabase.util.malli.registry :as mr])) | |
Impl for [[type-of]]. Use [[type-of]], but implement [[type-of-method]]. For MBQL clauses, try really hard not return an ambiguous set of possible types! Calculate things and determine what the result type will be! If we don't have enough information to determine the type (e.g. a | (defmulti type-of-method
{:arglists '([expr])}
(fn [x]
;; For the fallback case: use the actual type/class name as the dispatch type rather than `:type/*`. This is so we
;; can implement support for some platform-specific classes like `BigDecimal` or `java.time.OffsetDateTime`, for
;; use inside QP code or whatever. In the future maybe we can add support for JS-specific stuff too.
(let [dispatch-value (lib.dispatch/dispatch-value x)]
(if (= dispatch-value :dispatch-type/*)
(type x)
dispatch-value)))
:hierarchy lib.hierarchy/hierarchy) |
(defn- mbql-clause? [expr]
(and (vector? expr)
(keyword? (first expr)))) | |
(mr/def ::base-type [:or [:= ::type.unknown] ::common/base-type]) | |
(mu/defn type-of :- [:or
::base-type
[:set {:min 2} ::base-type]]
"Determine the type of an MBQL expression. Returns either a type keyword, or if the type is ambiguous, a set of
possible types."
[expr]
(or
;; for MBQL clauses with `:effective-type` or `:base-type` in their options: ignore their dumb [[type-of-method]] methods
;; and return that type directly. Ignore everything else! Life hack!
(and (mbql-clause? expr)
(map? (second expr))
(or (:effective-type (second expr))
(:base-type (second expr))))
(type-of-method expr))) | |
(defmethod type-of-method :default
[expr]
(throw (ex-info (i18n/tru "{0}: Don''t know how to determine the type of {1}" `type-of (pr-str expr))
{:expr expr}))) | |
for MBQL clauses whose type is the same as the type of the first arg. Also used for [[metabase.lib.metadata.calculation/type-of-method]]. | (defmethod type-of-method :lib.type-of/type-is-type-of-first-arg [[_tag _opts expr]] (type-of expr)) |
(defn- is-type? [x y]
(cond
(set? x) (some #(is-type? % y) x)
(set? y) (some #(is-type? x %) y)
(= x ::type.unknown) true
:else (isa? x y))) | |
Whether the [[type-of]] | (defn type-of?
[expr base-type]
(let [expr-type (type-of expr)]
(assert ((some-fn keyword? set?) expr-type)
(i18n/tru "type-of {0} returned an invalid type {1}" (pr-str expr) (pr-str expr-type)))
(is-type? expr-type base-type))) |
Schema that matches the following rules: 1a. expression is not an MBQL clause, OR 1b. expression is an registered MBQL clause and matches the schema registered with [[metabase.lib.schema.mbql-clause]], AND
| (defn- expression-schema
[base-type description]
[:and
[:or
[:fn
{:error/message "valid MBQL clause"
:error/fn (fn [{:keys [value]} _]
(str "invalid MBQL clause: " (pr-str value)))}
(complement mbql-clause?)]
[:ref :metabase.lib.schema.mbql-clause/clause]]
[:fn
{:error/message description}
#(type-of? % base-type)]]) |
(mr/def ::boolean (expression-schema :type/Boolean "expression returning a boolean")) | |
(mr/def ::string (expression-schema :type/Text "expression returning a string")) | |
(mr/def ::integer (expression-schema :type/Integer "expression returning an integer")) | |
(mr/def ::non-integer-real (expression-schema :type/Float "expression returning a non-integer real number")) | |
(mr/def ::number (expression-schema :type/Number "expression returning a number")) | |
(mr/def ::date (expression-schema :type/Date "expression returning a date")) | |
(mr/def ::time (expression-schema :type/Time "expression returning a time")) | |
(mr/def ::datetime (expression-schema :type/DateTime "expression returning a date time")) | |
(mr/def ::temporal (expression-schema :type/Temporal "expression returning a date, time, or date time")) | |
Set of base types that are orderable. | (def orderable-types
#{:type/Text :type/Number :type/Temporal :type/Boolean}) |
(mr/def ::orderable
(expression-schema orderable-types
"an expression that can be compared with :> or :<")) | |
Returns whether expressions Expressions are comparable if their types are comparable.
Two types t1 and t2 are comparable if either one is ::type.unknown, or
there is an orderable type t such that both | (defn comparable-expressions?
[x y]
(some boolean
(for [t1 (u/one-or-many (type-of x))
t2 (u/one-or-many (type-of y))
t orderable-types]
(or (= t1 ::type.unknown)
(= t2 ::type.unknown)
(and (types/assignable? t1 t)
(types/assignable? t2 t)))))) |
Set of base types that can be compared with equality. | (def equality-comparable-types
;; TODO: Adding :type/* here was necessary to prevent type errors for queries where a field's type in the DB could not
;; be determined better than :type/*. See #36841, where a MySQL enum field gets `:base-type :type/*`, and this check
;; would fail on `[:= {} [:field ...] "enum-str"]` without `:type/*` here.
;; This typing of each input should be replaced with an alternative scheme that checks that it's plausible to compare
;; all the args to an `:=` clause. Eg. comparing `:type/*` and `:type/String` is cool. Comparing `:type/IPAddress` to
;; `:type/Boolean` should fail; we can prove it's the wrong thing to do.
#{:type/Boolean :type/Text :type/Number :type/Temporal :type/IPAddress :type/MongoBSONID :type/Array :type/*}) |
(mr/def ::emptyable [:or [:ref ::string] (expression-schema :type/MongoBSONID "expression returning a BSONID")]) | |
(mr/def ::equality-comparable
[:maybe
(expression-schema equality-comparable-types
"an expression that can appear in := or :!=")]) | |
any type of expression. | (mr/def ::expression [:maybe (expression-schema :type/* "any type of expression")]) |
the | (mr/def ::expressions
[:sequential {:min 1} [:and [:ref ::expression]
[:cat :any [:map [:lib/expression-name :string]] [:* :any]]]]) |
Arithmetic expressions like | (ns metabase.lib.schema.expression.arithmetic (:require [malli.core :as mc] [medley.core :as m] [metabase.lib.hierarchy :as lib.hierarchy] [metabase.lib.schema.common :as common] [metabase.lib.schema.expression :as expression] [metabase.lib.schema.mbql-clause :as mbql-clause] [metabase.lib.schema.temporal-bucketing :as temporal-bucketing] [metabase.types :as types] [metabase.util.malli.registry :as mr])) |
(defn- valid-interval-for-type? [[_tag _opts _n unit :as _interval] expr-type]
(let [unit-schema (cond
(isa? expr-type :type/Date) ::temporal-bucketing/unit.date.interval
(isa? expr-type :type/Time) ::temporal-bucketing/unit.time.interval
(isa? expr-type :type/DateTime) ::temporal-bucketing/unit.date-time.interval)]
(if unit-schema
(mc/validate unit-schema unit)
true))) | |
(mr/def ::args.temporal
[:and
[:catn
[:expr [:schema [:ref ::expression/temporal]]]
[:intervals [:+ [:ref :mbql.clause/interval]]]]
[:fn
{:error/message "Temporal arithmetic expression with valid interval units for the expression type"}
(fn [[expr & intervals]]
(let [expr-type (expression/type-of expr)]
(every? #(valid-interval-for-type? % expr-type) intervals)))]]) | |
(mr/def ::args.numbers
[:repeat {:min 2} [:schema [:ref ::expression/number]]]) | |
Validate a | (defn- validate-plus-minus-temporal-arithmetic-expression
[[_tag _opts & exprs]]
(let [{non-intervals false, intervals true} (group-by #(isa? (expression/type-of %) :type/Interval) exprs)]
(cond
(not= (count non-intervals) 1)
"Temporal arithmetic expression must contain exactly one non-interval value"
(< (count intervals) 1)
"Temporal arithmetic expression must contain at least one :interval"
:else
(let [expr-type (expression/type-of (first non-intervals))]
(some (fn [[_tag _opts _n unit :as interval]]
(when-not (valid-interval-for-type? interval expr-type)
(str "Cannot add a " unit " interval to a " expr-type " expression")))
intervals))))) |
Create a schema for | (defn- plus-minus-temporal-interval-schema
[tag]
[:and
{:error/message (str tag " clause with a temporal expression and one or more :interval clauses")}
[:cat
[:= tag]
[:schema [:ref ::common/options]]
[:repeat [:schema [:ref :mbql.clause/interval]]]
[:schema [:ref ::expression/temporal]]
[:repeat [:schema [:ref :mbql.clause/interval]]]]
[:fn
{:error/fn (fn [{:keys [value]} _]
(str "Invalid " tag " clause: " (validate-plus-minus-temporal-arithmetic-expression value)))}
(complement validate-plus-minus-temporal-arithmetic-expression)]]) |
Create a schema for | (defn- plus-minus-numeric-schema
[tag]
[:cat
{:error/message (str tag " clause with numeric args")}
[:= tag]
[:schema [:ref ::common/options]]
[:repeat {:min 2} [:schema [:ref ::expression/number]]]]) |
Given a sequence of args to a numeric arithmetic expression like | (defn- type-of-numeric-arithmetic-args
[args]
;; Okay to use reduce without an init value here since we know we have >= 2 args
#_{:clj-kondo/ignore [:reduce-without-init]}
(reduce
types/most-specific-common-ancestor
(map (fn [expr]
(let [expr-type (expression/type-of expr)]
(if (and (isa? expr-type ::expression/type.unknown)
(mc/validate :metabase.lib.schema.ref/ref expr))
:type/Number
expr-type)))
args))) |
Given a temporal value plus one or more intervals | (defn- type-of-temporal-arithmetic-args
[args]
(let [first-non-interval-arg-type (m/find-first #(not (isa? % :type/Interval))
(map expression/type-of args))]
(if (isa? first-non-interval-arg-type ::expression/type.unknown)
:type/Temporal
first-non-interval-arg-type))) |
Given a sequence of
| (defn- type-of-arithmetic-args
[tag args]
(cond
;; temporal value + intervals
(some #(isa? (expression/type-of %) :type/Interval) args)
(type-of-temporal-arithmetic-args args)
;; the difference of exactly two temporal values
(and (= tag :-)
(= (count args) 2)
(or (every? #(isa? (expression/type-of %) :type/Date) args)
(every? #(isa? (expression/type-of %) :type/DateTime) args)))
:type/Interval
;; fall back to numeric args
:else (type-of-numeric-arithmetic-args args))) |
(def ^:private temporal-difference-schema
[:cat
{:error/message ":- clause taking the difference of two temporal expressions"}
[:= :-]
[:schema [:ref ::common/options]]
[:schema [:ref ::expression/temporal]]
[:schema [:ref ::expression/temporal]]]) | |
(mbql-clause/define-mbql-clause :+ [:or (plus-minus-temporal-interval-schema :+) (plus-minus-numeric-schema :+)]) | |
TODO -- should | (mbql-clause/define-mbql-clause :- [:or (plus-minus-temporal-interval-schema :-) temporal-difference-schema (plus-minus-numeric-schema :-)]) |
(mbql-clause/define-catn-mbql-clause :* [:args ::args.numbers]) | |
we always do non-integer real division even if all the expressions are integers, e.g. [:/ so the results are 0.5 as opposed to 0. This is what people expect division to do | (mbql-clause/define-catn-mbql-clause :/ :- :type/Float [:args ::args.numbers]) |
(doseq [tag [:+ :- :*]] (lib.hierarchy/derive tag :lib.type-of/type-is-type-of-arithmetic-args)) | |
| (defmethod expression/type-of-method :lib.type-of/type-is-type-of-arithmetic-args [[tag _opts & args]] (type-of-arithmetic-args tag args)) |
(mbql-clause/define-tuple-mbql-clause :abs [:schema [:ref ::expression/number]]) | |
(lib.hierarchy/derive :abs :lib.type-of/type-is-type-of-first-arg) | |
(doseq [op [:log :exp :sqrt]]
(mbql-clause/define-tuple-mbql-clause op :- :type/Float
[:schema [:ref ::expression/number]])) | |
(doseq [op [:ceil :floor :round]]
(mbql-clause/define-tuple-mbql-clause op :- :type/Integer
[:schema [:ref ::expression/number]])) | |
(mbql-clause/define-tuple-mbql-clause :power #_num [:schema [:ref ::expression/number]] #_exp [:schema [:ref ::expression/number]]) | |
(defmethod expression/type-of-method :power
[[_tag _opts expr exponent]]
;; if both expr and exponent are integers, this will return an integer.
(if (and (isa? (expression/type-of expr) :type/Integer)
(isa? (expression/type-of exponent) :type/Integer))
:type/Integer
;; otherwise this will return some sort of number with a decimal place. e.g.
;;
;; (Math/pow 2 2.1) => 4.2870938501451725
;;
;; If we don't know the type of `expr` or `exponent` it's safe to assume `:type/Float` anyway, maybe not as
;; specific as `:type/Integer` but better than `:type/*` or `::expression/type.unknown`.
:type/Float)) | |
Conditional expressions like | (ns metabase.lib.schema.expression.conditional (:require [clojure.set :as set] [metabase.lib.schema.expression :as expression] [metabase.lib.schema.mbql-clause :as mbql-clause] [metabase.types :as types] [metabase.util.malli.registry :as mr])) |
For expressions like the logic for calculating the return type of a | (defn- best-return-type
[x y]
(cond
(nil? x)
y
;; if the type of either x or y is unknown, then the overall type of this has to be unknown as well.
(or (= x ::expression/type.unknown)
(= y ::expression/type.unknown))
::expression/type.unknown
;; if both types are keywords return their most-specific ancestor.
(and (keyword? x)
(keyword? y))
(types/most-specific-common-ancestor x y)
;; if one type is a specific type but the other is an ambiguous union of possible types, return the specific
;; type. A case can't possibly have multiple different return types, so if one expression has an unambiguous
;; type then the whole thing has to have a compatible type.
(keyword? x)
x
(keyword? y)
y
;; if both types are ambiguous unions of possible types then return the intersection of the two. But if the
;; intersection is empty, return the union of everything instead. I don't really want to go down a rabbit
;; hole of trying to find the intersection between the most-specific common ancestors
:else
(or (when-let [intersection (not-empty (set/intersection x y))]
(if (= (count intersection) 1)
(first intersection)
intersection))
(set/union x y)))) |
believe it or not, a | (mr/def ::case-subclause
[:tuple
{:error/message "Valid :case [pred expr] pair"}
#_pred [:ref ::expression/boolean]
#_expr [:ref ::expression/expression]]) |
(mbql-clause/define-catn-mbql-clause :case
;; TODO -- we should further constrain this so all of the exprs are of the same type
[:pred-expr-pairs [:sequential {:min 1} [:ref ::case-subclause]]]
[:default [:? [:schema [:ref ::expression/expression]]]]) | |
(defmethod expression/type-of-method :case
[[_tag _opts pred-expr-pairs default]]
(reduce
(fn [best-guess [_pred expr]]
(let [expr-type (expression/type-of expr)]
(best-return-type best-guess expr-type)))
(when (some? default)
(expression/type-of default))
pred-expr-pairs)) | |
TODO -- add constraint that these types have to be compatible | (mbql-clause/define-catn-mbql-clause :coalesce
[:exprs [:repeat {:min 2} [:schema [:ref ::expression/expression]]]]) |
(defmethod expression/type-of-method :coalesce
[[_tag _opts & exprs]]
#_{:clj-kondo/ignore [:reduce-without-init]}
(reduce best-return-type
(map expression/type-of exprs))) | |
(ns metabase.lib.schema.expression.string
(:require
[metabase.lib.schema.expression :as expression]
[metabase.lib.schema.mbql-clause :as mbql-clause])) | |
(doseq [op [:trim :ltrim :rtrim :upper :lower]]
(mbql-clause/define-tuple-mbql-clause op :- :type/Text
[:schema [:ref ::expression/string]])) | |
(mbql-clause/define-tuple-mbql-clause :length :- :type/Integer [:schema [:ref ::expression/string]]) | |
(doseq [op [:regexextract :regex-match-first]]
(mbql-clause/define-tuple-mbql-clause op :- :type/Text
#_str [:schema [:ref ::expression/string]]
;; TODO regex type?
#_regex [:schema [:ref ::expression/string]])) | |
(mbql-clause/define-tuple-mbql-clause :replace :- :type/Text #_str [:schema [:ref ::expression/string]] #_find [:schema [:ref ::expression/string]] #_replace [:schema [:ref ::expression/string]]) | |
(mbql-clause/define-catn-mbql-clause :substring :- :type/Text [:str [:schema [:ref ::expression/string]]] [:start [:schema [:ref ::expression/integer]]] [:length [:? [:schema [:ref ::expression/integer]]]]) | |
(mbql-clause/define-catn-mbql-clause :concat :- :type/Text
[:args [:repeat {:min 2} [:schema [:ref ::expression/expression]]]]) | |
Schemas for the various types of filter clauses that you'd pass to | (ns metabase.lib.schema.filter (:require [metabase.lib.schema.common :as common] [metabase.lib.schema.expression :as expression] [metabase.lib.schema.mbql-clause :as mbql-clause] [metabase.lib.schema.temporal-bucketing :as temporal-bucketing] [metabase.util.malli.registry :as mr])) |
Helper intended for use with [[define-mbql-clause]]. Create a clause schema with | (defn- tuple-clause-of-comparables-schema
[compared-position-pairs]
(fn [tag & args]
{:pre [(simple-keyword? tag)]}
[:and
(apply mbql-clause/tuple-clause-schema tag args)
[:fn
{:error/message "arguments should be comparable"}
(fn [[_tag _opts & args]]
(let [argv (vec args)]
(every? true? (map (fn [[i j]]
(expression/comparable-expressions? (get argv i) (get argv j)))
compared-position-pairs))))]])) |
(doseq [op [:and :or]]
(mbql-clause/define-catn-mbql-clause op :- :type/Boolean
[:args [:repeat {:min 2} [:schema [:ref ::expression/boolean]]]])) | |
(mbql-clause/define-tuple-mbql-clause :not :- :type/Boolean [:ref ::expression/boolean]) | |
(doseq [op [:= :!=]]
(mbql-clause/define-catn-mbql-clause op :- :type/Boolean
[:args [:repeat {:min 2} [:schema [:ref ::expression/equality-comparable]]]])) | |
(doseq [op [:< :<= :> :>=]]
(mbql-clause/define-mbql-clause-with-schema-fn (tuple-clause-of-comparables-schema #{[0 1]})
op :- :type/Boolean
#_x [:ref ::expression/orderable]
#_y [:ref ::expression/orderable])) | |
(mbql-clause/define-mbql-clause-with-schema-fn (tuple-clause-of-comparables-schema #{[0 1] [0 2]})
:between :- :type/Boolean
;; TODO -- should we enforce that min is <= max (for literal number values?)
#_expr [:ref ::expression/orderable]
#_min [:ref ::expression/orderable]
#_max [:ref ::expression/orderable]) | |
sugar: a pair of | (mbql-clause/define-mbql-clause-with-schema-fn (tuple-clause-of-comparables-schema #{[0 2] [0 4] [1 3] [1 5]})
:inside :- :type/Boolean
;; TODO -- should we enforce that lat-min <= lat-max and lon-min <= lon-max? Should we enforce that -90 <= lat 90
;; and -180 <= lon 180 ?? (for literal number values)
#_lat-expr [:ref ::expression/orderable]
#_lon-expr [:ref ::expression/orderable]
#_lat-max [:ref ::expression/orderable] ; north
#_lon-min [:ref ::expression/orderable] ; west
#_lat-min [:ref ::expression/orderable] ; south
#_lon-max [:ref ::expression/orderable]) ; east |
null checking expressions these are sugar for [:= ... nil] and [:!= ... nil] respectively | (doseq [op [:is-null :not-null]]
(mbql-clause/define-tuple-mbql-clause op :- :type/Boolean
[:ref ::expression/expression])) |
one-arg [:ref ::expression/string] filter clauses :is-empty is sugar for [:or [:= ... nil] [:= ... ""]] :not-empty is sugar for [:and [:!= ... nil] [:!= ... ""]] | (doseq [op [:is-empty :not-empty]]
(mbql-clause/define-tuple-mbql-clause op :- :type/Boolean
[:ref ::expression/emptyable])) |
(def ^:private string-filter-options
[:map [:case-sensitive {:optional true} :boolean]]) ; default true | |
binary [:ref ::expression/string] filter clauses. These also accept a
[:does-not-contain ...] = [:not [:contains ...]] | (doseq [op [:starts-with :ends-with :contains :does-not-contain]]
(mbql-clause/define-mbql-clause op :- :type/Boolean
[:tuple
[:= op]
[:merge ::common/options string-filter-options]
#_whole [:ref ::expression/string]
#_part [:ref ::expression/string]])) |
(def ^:private time-interval-options
[:map [:include-current {:optional true} :boolean]]) ; default false | |
SUGAR: rewritten as a filter clause with a relative-datetime value | (mbql-clause/define-mbql-clause :time-interval :- :type/Boolean
;; TODO -- we should probably further constrain this so you can't do weird stuff like
;;
;; [:time-interval {} <time> :current :year]
;;
;; using units that don't agree with the expr type
[:tuple
[:= :time-interval]
[:merge ::common/options time-interval-options]
#_expr [:ref ::expression/temporal]
#_n [:or
[:enum :current :last :next]
;; I guess there's no reason you shouldn't be able to do something like 1 + 2 in here
[:ref ::expression/integer]]
#_unit [:ref ::temporal-bucketing/unit.date-time.interval]]) |
segments are guaranteed to return valid filter clauses and thus booleans, right? | (mbql-clause/define-mbql-clause :segment :- :type/Boolean [:tuple [:= :segment] ::common/options [:or ::common/positive-int ::common/non-blank-string]]) |
(mr/def ::operator [:map [:lib/type [:= :operator/filter]] [:short [:enum := :!= :inside :between :< :> :<= :>= :is-null :not-null :is-empty :not-empty :contains :does-not-contain :starts-with :ends-with]] ;; this is used for display name and it depends on the arguments to the filter clause itself... e.g. ;; ;; number_a < number_b ;; ;; gets a display name of "less than" for the operator, while ;; ;; timestamp_a < timestamp_b ;; ;; gets a display name of "before" for the operator. We don't want to encode the display name in the `::operator` ;; definition itself, because it forces us to do i18n in the definition itself; it's nicer to have static ;; definitions and only add the display name when we call `display-name` or `display-info`. [:display-name-variant :keyword]]) | |
(ns metabase.lib.schema.id (:require [metabase.lib.schema.common :as common] [metabase.util.malli.registry :as mr])) | |
these aren't anything special right now, but maybe in the future we can do something special/intelligent with them, e.g. when we start working on the generative stuff | |
(mr/def ::database ::common/positive-int) | |
The ID used to signify that a database is 'virtual' rather than physical. A fake integer ID is used so as to minimize the number of changes that need to be made on the frontend -- by using something that would otherwise be a legal ID, nothing need change there, and the frontend can query against this 'database' none the wiser. (This integer ID is negative which means it will never conflict with a real database ID.) This ID acts as a sort of flag. The relevant places in the middleware can check whether the DB we're querying is this 'virtual' database and take the appropriate actions. | (def saved-questions-virtual-database-id -1337) |
not sure under what circumstances we actually want to allow this, this is an icky hack. How are we supposed to resolve stuff with a fake Database ID? I guess as far as the schema is concerned we can allow this tho. EDIT: Sometimes the FE uses this when starting a query based on a Card if it doesn't know the database associated with that Card. The QP will resolve this to the correct Database later. | (mr/def ::saved-questions-virtual-database [:= saved-questions-virtual-database-id]) |
(mr/def ::table ::common/positive-int) | |
(mr/def ::field ::common/positive-int) | |
(mr/def ::card ::common/positive-int) | |
(mr/def ::segment ::common/positive-int) | |
(mr/def ::metric ::common/positive-int) | |
(mr/def ::snippet ::common/positive-int) | |
(mr/def ::dimension ::common/positive-int) | |
Schemas for things related to joins. | (ns metabase.lib.schema.join (:require [metabase.lib.schema.common :as common] [metabase.lib.schema.expression :as expression] [metabase.shared.util.i18n :as i18n] [metabase.util.malli.registry :as mr])) |
The Fields to include in the results if a top-level
Driver implementations: you can ignore this clause. Relevant fields will be added to top-level | (mr/def ::fields
[:or
[:enum :all :none]
;; TODO -- `:fields` is supposed to be distinct (ignoring UUID), e.g. you can't have `[:field {} 1]` in there
;; twice. (#32489)
[:sequential {:min 1} [:ref :mbql.clause/field]]]) |
The name used to alias the joined table or query. This is usually generated automatically and generally looks
like Driver implementations: This is guaranteed to be present after pre-processing. | (mr/def ::alias
[:or
{:gen/fmap #(str % "-" (random-uuid))}
::common/non-blank-string]) |
(mr/def ::conditions
[:sequential {:min 1} [:ref ::expression/boolean]]) | |
valid values for the optional When | (mr/def ::strategy [:enum :left-join :right-join :inner-join :full-join]) |
(mr/def ::join
[:map
[:lib/type [:= :mbql/join]]
[:lib/options ::common/options]
[:stages [:ref :metabase.lib.schema/stages]]
[:conditions ::conditions]
[:alias ::alias]
[:fields {:optional true} ::fields]
[:strategy {:optional true} ::strategy]]) | |
(mr/def ::joins
[:and
[:sequential {:min 1} [:ref ::join]]
[:fn
{:error/fn (fn [& _]
(i18n/tru "Join aliases must be unique at a given stage of a query"))}
(fn ensure-unique-join-aliases [joins]
(if-let [aliases (not-empty (filter some? (map :alias joins)))]
(apply distinct? aliases)
true))]]) | |
(mr/def ::strategy.option
[:map
[:lib/type [:= :option/join.strategy]]
[:strategy [:ref ::strategy]]
[:default {:optional true} :boolean]]) | |
JVM-specific literal definitions. | (ns metabase.lib.schema.literal.jvm (:require [metabase.lib.schema.expression :as expression] [metabase.util.malli.registry :as mr])) |
(set! *warn-on-reflection* true) | |
Convenience for defining a Malli schema for an instance of a particular Class. | (defn instance-of
[^Class klass]
[:fn {:error/message (str "instance of " (.getName klass))}
#(instance? klass %)]) |
(mr/def ::big-integer [:or (instance-of java.math.BigInteger) (instance-of clojure.lang.BigInt)]) | |
(defmethod expression/type-of-method java.math.BigInteger [_n] :type/BigInteger) | |
(defmethod expression/type-of-method clojure.lang.BigInt [_n] :type/BigInteger) | |
(mr/def ::big-decimal (instance-of java.math.BigDecimal)) | |
(defmethod expression/type-of-method java.math.BigDecimal [_n] :type/Decimal) | |
(mr/def ::float (instance-of Float)) | |
(defmethod expression/type-of-method java.time.LocalDate [_t] :type/DateTime) | |
(defmethod expression/type-of-method java.time.LocalTime [_t] :type/Time) | |
(defmethod expression/type-of-method java.time.OffsetTime [_t] :type/TimeWithTZ) | |
(defmethod expression/type-of-method java.time.LocalDateTime [_t] :type/DateTime) | |
(defmethod expression/type-of-method java.time.OffsetDateTime [_t] :type/DateTimeWithZoneOffset) | |
(defmethod expression/type-of-method java.time.ZonedDateTime [_t] :type/DateTimeWithZoneID) | |
(ns metabase.lib.schema.mbql-clause (:require [malli.core :as mc] [metabase.lib.schema.common :as common] [metabase.lib.schema.expression :as expression] [metabase.types] [metabase.util.malli :as mu] [metabase.util.malli.registry :as mr])) | |
(comment metabase.types/keep-me) | |
Set of all registered MBQL clause tags e.g. #{:starts-with} | (defonce ^:private tag-registry
(atom #{})) |
Given an MBQL clause tag like | (defn- tag->registered-schema-name [tag] (keyword "mbql.clause" (name tag))) |
Build the schema for | (defn- clause-schema
[]
(into [:multi
{:dispatch first
:error/fn (fn [{:keys [value]} _]
(if (vector? value)
(str "Invalid " (pr-str (first value)) " clause: " (pr-str value))
"not an MBQL clause"))}
[::mc/default [:fn {:error/message "not a known MBQL clause"} (constantly false)]]]
(map (fn [tag]
[tag [:ref (tag->registered-schema-name tag)]]))
@tag-registry)) |
(defn- update-clause-schema! []
(mr/def ::clause
(clause-schema))) | |
create an initial empty definition of | (update-clause-schema!) |
whenever [[tag-registry]] is updated, update the | (add-watch tag-registry
::update-schemas
(fn [_key _ref _old-state _new-state]
(update-clause-schema!))) |
Register the (define-mbql-clause :is-null :- :type/Boolean [:tuple [:= :is-null] ::common/options [:ref :metabase.lib.schema.expression/expression]]) | (mu/defn define-mbql-clause
([tag :- simple-keyword?
schema]
(let [schema-name (tag->registered-schema-name tag)]
(mr/def schema-name schema)
;; only need to update the registry and calculated schemas if this is the very first time we're defining this
;; clause. Otherwise since they're wrapped in `:ref` we don't need to recalculate them. This way we can avoid tons
;; of pointless recalculations every time we reload a namespace.
(when-not (contains? @tag-registry tag)
(swap! tag-registry conj tag)))
nil)
([tag :- simple-keyword?
_arrow :- [:= :-]
return-type :- ::expression/base-type
schema]
(define-mbql-clause tag schema)
(defmethod expression/type-of-method tag
[_clause]
return-type)
nil)) |
TODO -- add more stuff. | |
Helper intended for use with [[define-mbql-clause]]. Create an MBQL clause schema with | (defn catn-clause-schema
[tag & args]
{:pre [(simple-keyword? tag)
(every? vector? args)
(every? keyword? (map first args))]}
[:schema
(into [:catn
{:error/message (str "Valid " tag " clause")}
[:tag [:= tag]]
[:options [:schema [:ref ::common/options]]]]
args)]) |
Helper intended for use with [[define-mbql-clause]]. Create a clause schema with | (defn tuple-clause-schema
[tag & args]
{:pre [(simple-keyword? tag)]}
(into [:tuple
{:error/message (str "Valid " tag " clause")}
[:= tag]
[:ref ::common/options]]
args)) |
Even more convenient functions! | |
Helper. Combines [[define-mbql-clause]] and the result of applying | (defn define-mbql-clause-with-schema-fn
[schema-fn tag & args]
(let [[return-type & args] (if (= (first args) :-)
(cons (second args) (drop 2 args))
(cons nil args))
schema (apply schema-fn tag args)]
(if return-type
(define-mbql-clause tag :- return-type schema)
(define-mbql-clause tag schema)))) |
Helper. Combines [[define-mbql-clause]] and [[tuple-clause-schema]]. | (defn define-tuple-mbql-clause [tag & args] (apply define-mbql-clause-with-schema-fn tuple-clause-schema tag args)) |
Helper. Combines [[define-mbql-clause]] and [[catn-clause-schema]]. | (defn define-catn-mbql-clause [tag & args] (apply define-mbql-clause-with-schema-fn catn-clause-schema tag args)) |
For REPL/test usage: get the definition of the schema associated with an MBQL clause tag. | (defn resolve-schema [tag] (mr/resolve-schema (tag->registered-schema-name tag))) |
(ns metabase.lib.schema.metadata (:require [metabase.lib.metadata.protocols :as lib.metadata.protocols] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.id :as lib.schema.id] [metabase.util.malli.registry :as mr])) | |
Column vs Field? Lately I've been using Column = any column returned by a query or stage of a query
Field = a Column that is associated with a capital-F Field in the application database, i.e. has an All Fields are Columns, but not all Columns are Fields. Also worth a mention: we also have | |
(mr/def ::column-source [:enum ;; these are for things from some sort of source other than the current stage; ;; they must be referenced with string names rather than Field IDs :source/card :source/native :source/previous-stage ;; these are for things that were introduced by the current stage of the query; `:field` references should be ;; referenced with Field IDs if available. ;; ;; default columns returned by the `:source-table` for the current stage. :source/table-defaults ;; specifically introduced by the corresponding top-level clauses. :source/fields :source/aggregations :source/breakouts ;; introduced by a join, not necessarily ultimately returned. :source/joins ;; Introduced by `:expressions`; not necessarily ultimately returned. :source/expressions ;; Not even introduced, but 'visible' because this column is implicitly joinable. :source/implicitly-joinable]) | |
The way FieldValues/remapping works is hella confusing, because it involves the FieldValues table and Dimension
table, and the | |
Possible options for column metadata | (def column-has-field-values-options
;; AUTOMATICALLY-SET VALUES, SET DURING SYNC
;;
;; `nil` -- means infer which widget to use based on logic in [[metabase.lib.field/infer-has-field-values]]; this
;; will either return `:search` or `:none`.
;;
;; This is the default state for Fields not marked `auto-list`. Admins cannot explicitly mark a Field as
;; `has_field_values` `nil`. This value is also subject to automatically change in the future if the values of a
;; Field change in such a way that it can now be marked `auto-list`. Fields marked `nil` do *not* have FieldValues
;; objects.
;;
#{;; The other automatically-set option. Automatically marked as a 'List' Field based on cardinality and other factors
;; during sync. Store a FieldValues object; use the List Widget. If this Field goes over the distinct value
;; threshold in a future sync, the Field will get switched back to `has_field_values = nil`.
;;
;; Note that when this comes back from the REST API or [[metabase.lib.field/field-values-search-info]] we always
;; return this as `:list` instead of `:auto-list`; this is done by [[metabase.lib.field/infer-has-field-values]].
;; I guess this is because the FE isn't supposed to need to care about whether this is `:auto-list` vs `:list`;
;; those distinctions are only important for sync I guess.
:auto-list
;;
;; EXPLICITLY-SET VALUES, SET BY AN ADMIN
;;
;; Admin explicitly marked this as a 'Search' Field, which means we should *not* keep FieldValues, and should use
;; Search Widget.
:search
;; Admin explicitly marked this as a 'List' Field, which means we should keep FieldValues, and use the List
;; Widget. Unlike `auto-list`, if this Field grows past the normal cardinality constraints in the future, it will
;; remain `List` until explicitly marked otherwise.
:list
;; Admin explicitly marked that this Field shall always have a plain-text widget, neither allowing search, nor
;; showing a list of possible values. FieldValues not kept.
:none}) |
(mr/def ::column.has-field-values (into [:enum] (sort column-has-field-values-options))) | |
External remapping (Dimension) for a column. From the [[metabase.models.dimension]] with | (mr/def ::column.remapping.external [:map [:lib/type [:= :metadata.column.remapping/external]] [:id ::lib.schema.id/dimension] ;; from `dimension.name` [:name ::lib.schema.common/non-blank-string] ;; `dimension.human_readable_field_id` in the application database. ID of the Field to get human-readable values ;; from. e.g. if the column in question is `venues.category-id`, then this would be the ID of `categories.name` [:field-id ::lib.schema.id/field]]) |
Internal remapping (FieldValues) for a column. From [[metabase.models.dimension]] with | (mr/def ::column.remapping.internal [:map [:lib/type [:= :metadata.column.remapping/internal]] [:id ::lib.schema.id/dimension] ;; from `dimension.name` [:name ::lib.schema.common/non-blank-string] ;; From `metabase_fieldvalues.values`. Original values [:values [:sequential :any]] ;; From `metabase_fieldvalues.human_readable_values`. Human readable remaps for the values at the same indexes in ;; `:values` [:human-readable-values [:sequential :any]]]) |
(mr/def ::column
[:map
{:error/message "Valid column metadata"}
[:lib/type [:= :metadata/column]]
;; column names are allowed to be empty strings in SQL Server :/
[:name :string]
;; TODO -- ignore `base_type` and make `effective_type` required; see #29707
[:base-type ::lib.schema.common/base-type]
[:id {:optional true} ::lib.schema.id/field]
[:display-name {:optional true} [:maybe :string]]
[:effective-type {:optional true} [:maybe ::lib.schema.common/base-type]]
;; if this is a field from another table (implicit join), this is the field in the current table that should be
;; used to perform the implicit join. e.g. if current table is `VENUES` and this field is `CATEGORIES.ID`, then the
;; `fk_field_id` would be `VENUES.CATEGORY_ID`. In a `:field` reference this is saved in the options map as
;; `:source-field`.
[:fk-field-id {:optional true} [:maybe ::lib.schema.id/field]]
;; `metabase_field.fk_target_field_id` in the application database; recorded during the sync process. This Field is
;; an foreign key, and points to this Field ID. This is mostly used to determine how to add implicit joins by
;; the [[metabase.query-processor.middleware.add-implicit-joins]] middleware.
[:fk-target-field-id {:optional true} [:maybe ::lib.schema.id/field]]
;; Join alias of the table we're joining against, if any. Not really 100% clear why we would need this on top
;; of [[metabase.lib.join/current-join-alias]], which stores the same info under a namespaced key. I think we can
;; remove it.
[:source-alias {:optional true} [:maybe ::lib.schema.common/non-blank-string]]
;; name of the expression where this column metadata came from. Should only be included for expressions introduced
;; at THIS STAGE of the query. If it's included elsewhere, that's an error. Thus this is the definitive way to know
;; if a column is "custom" in this stage (needs an `:expression` reference) or not.
[:lib/expression-name {:optional true} [:maybe ::lib.schema.common/non-blank-string]]
;; what top-level clause in the query this metadata originated from, if it is calculated (i.e., if this metadata
;; was generated by [[metabase.lib.metadata.calculation/metadata]])
[:lib/source {:optional true} [:ref ::column-source]]
;; ID of the Card this came from, if this came from Card results metadata. Mostly used for creating column groups.
[:lib/card-id {:optional true} [:maybe ::lib.schema.id/card]]
;;
;; this stuff is adapted from [[metabase.query-processor.util.add-alias-info]]. It is included in
;; the [[metabase.lib.metadata.calculation/metadata]]
;;
;; the alias that should be used to this clause on the LHS of a `SELECT <lhs> AS <rhs>` or equivalent, i.e. the
;; name of this clause as exported by the previous stage, source table, or join.
[:lib/source-column-alias {:optional true} [:maybe ::lib.schema.common/non-blank-string]]
;; the name we should export this column as, i.e. the RHS of a `SELECT <lhs> AS <rhs>` or equivalent. This is
;; guaranteed to be unique in each stage of the query.
[:lib/desired-column-alias {:optional true} [:maybe [:string {:min 1, :max 60}]]]
;; when column metadata is returned by certain things
;; like [[metabase.lib.aggregation/selected-aggregation-operators]] or [[metabase.lib.field/fieldable-columns]], it
;; might include this key, which tells you whether or not that column is currently selected or not already, e.g.
;; for [[metabase.lib.field/fieldable-columns]] it means its already present in `:fields`
[:selected? {:optional true} :boolean]
;;
;; REMAPPING & FIELD VALUES
;;
;; See notes above for more info. `:has-field-values` comes from the application database and is used to decide
;; whether to sync FieldValues when running sync, and what certain FE QB widgets should
;; do. (See [[metabase.lib.field/field-values-search-info]]). Note that all metadata providers may not return this
;; column. The JVM provider currently does not, since the QP doesn't need it for anything.
[:has-field-values {:optional true} [:maybe [:ref ::column.has-field-values]]]
;;
;; these next two keys are derived by looking at `FieldValues` and `Dimension` instances associated with a `Field`;
;; they are used by the Query Processor to add column remappings to query results. To see how this maps to stuff in
;; the application database, look at the implementation for fetching a `:metadata/column`
;; in [[metabase.lib.metadata.jvm]]. I don't think this is really needed on the FE, at any rate the JS metadata
;; provider doesn't add these keys.
[:lib/external-remap {:optional true} [:maybe [:ref ::column.remapping.external]]]
[:lib/internal-remap {:optional true} [:maybe [:ref ::column.remapping.internal]]]]) | |
Definition spec for a cached table. | (mr/def ::persisted-info.definition
[:map
[:table-name ::lib.schema.common/non-blank-string]
[:field-definitions [:maybe [:sequential
[:map
[:field-name ::lib.schema.common/non-blank-string]
;; TODO check (isa? :type/Integer :type/*)
[:base-type ::lib.schema.common/base-type]]]]]]) |
Persisted Info = Cached Table (?). See [[metabase.models.persisted-info]] | (mr/def ::persisted-info
[:map
[:active :boolean]
[:state ::lib.schema.common/non-blank-string]
[:table-name ::lib.schema.common/non-blank-string]
[:definition {:optional true} [:maybe [:ref ::persisted-info.definition]]]
[:query-hash {:optional true} [:maybe ::lib.schema.common/non-blank-string]]]) |
(mr/def ::card
[:map
{:error/message "Valid Card metadata"}
[:lib/type [:= :metadata/card]]
[:id ::lib.schema.id/card]
[:name ::lib.schema.common/non-blank-string]
[:database-id ::lib.schema.id/database]
;; saved query. This is possibly still a legacy query, but should already be normalized.
;; Call [[metabase.lib.convert/->pMBQL]] on it as needed
[:dataset-query {:optional true} :map]
;; vector of column metadata maps; these are ALMOST the correct shape to be [[ColumnMetadata]], but they're
;; probably missing `:lib/type` and probably using `:snake_case` keys.
[:result-metadata {:optional true} [:maybe [:sequential :map]]]
;; whether this Card is a Model or not.
[:dataset {:optional true} :boolean]
;; Table ID is nullable in the application database, because native queries are not necessarily associated with a
;; particular Table (unless they are against MongoDB)... for MBQL queries it should be populated however.
[:table-id {:optional true} [:maybe ::lib.schema.id/table]]
;;
;; PERSISTED INFO: This comes from the [[metabase.models.persisted-info]] model.
;;
[:lib/persisted-info {:optional true} [:maybe [:ref ::persisted-info]]]]) | |
(mr/def ::segment
[:map
{:error/message "Valid Segment metadata"}
[:lib/type [:= :metadata/segment]]
[:id ::lib.schema.id/segment]
[:name ::lib.schema.common/non-blank-string]
[:table-id ::lib.schema.id/table]
;; the MBQL snippet defining this Segment; this may still be in legacy
;; format. [[metabase.lib.segment/segment-definition]] handles conversion to pMBQL if needed.
[:definition [:maybe :map]]
[:description {:optional true} [:maybe ::lib.schema.common/non-blank-string]]]) | |
(mr/def ::metric
[:map
{:error/message "Valid Metric metadata"}
[:lib/type [:= :metadata/metric]]
[:id ::lib.schema.id/metric]
[:name ::lib.schema.common/non-blank-string]
[:table-id ::lib.schema.id/table]
;; the MBQL snippet defining this Metric; this may still be in legacy
;; format. [[metabase.lib.metric/metric-definition]] handles conversion to pMBQL if needed.
[:definition [:maybe :map]]
[:description {:optional true} [:maybe ::lib.schema.common/non-blank-string]]]) | |
(mr/def ::table
[:map
{:error/message "Valid Table metadata"}
[:lib/type [:= :metadata/table]]
[:id ::lib.schema.id/table]
[:name ::lib.schema.common/non-blank-string]
[:display-name {:optional true} [:maybe ::lib.schema.common/non-blank-string]]
[:schema {:optional true} [:maybe ::lib.schema.common/non-blank-string]]]) | |
(mr/def ::database
[:map
{:error/message "Valid Database metadata"}
[:lib/type [:= :metadata/database]]
[:id ::lib.schema.id/database]
;; TODO -- this should validate against the driver features list in [[metabase.driver/driver-features]] if we're in
;; Clj mode
[:dbms-version {:optional true} [:maybe :map]]
[:details {:optional true} :map]
[:engine {:optional true} :keyword]
[:features {:optional true} [:set :keyword]]
[:is-audit {:optional true} :boolean]
[:settings {:optional true} [:maybe :map]]]) | |
(mr/def ::metadata-provider
[:fn
{:error/message "Valid MetadataProvider"}
#'lib.metadata.protocols/metadata-provider?]) | |
(mr/def ::metadata-providerable
[:or
[:ref ::metadata-provider]
[:map
{:error/message "map with a MetadataProvider in the key :lib/metadata (i.e. a query)"}
[:lib/metadata [:ref ::metadata-provider]]]]) | |
Schemas for order-by clauses. | (ns metabase.lib.schema.order-by (:require [metabase.lib.schema.expression :as expression] [metabase.lib.schema.mbql-clause :as mbql-clause] [metabase.util.malli.registry :as mr])) |
(mr/def ::direction [:enum :asc :desc]) | |
(mbql-clause/define-tuple-mbql-clause :asc [:ref ::expression/orderable]) | |
(mbql-clause/define-tuple-mbql-clause :desc [:ref ::expression/orderable]) | |
(mr/def ::order-by
[:and
[:ref ::mbql-clause/clause]
[:fn
{:error/message ":asc or :desc clause"}
(fn [[tag]]
(#{:asc :desc} tag))]]) | |
TODO -- should there be a no-duplicates constraint here? | (mr/def ::order-bys
[:sequential {:min 1} [:ref ::order-by]]) |
Malli schema for a Field, aggregation, or expression reference (etc.) | (ns metabase.lib.schema.ref (:require [clojure.string :as str] [metabase.lib.dispatch :as lib.dispatch] [metabase.lib.hierarchy :as lib.hierarchy] [metabase.lib.schema.common :as common] [metabase.lib.schema.expression :as expression] [metabase.lib.schema.id :as id] [metabase.lib.schema.mbql-clause :as mbql-clause] [metabase.lib.schema.temporal-bucketing :as temporal-bucketing] [metabase.types] [metabase.util.malli.registry :as mr])) |
(comment metabase.types/keep-me) | |
(mr/def ::field.options
[:merge
::common/options
[:map
[:temporal-unit {:optional true} ::temporal-bucketing/unit]]]) | |
(mr/def ::field.literal.options
[:merge
::field.options
[:map
[:base-type ::common/base-type]]]) | |
| (mr/def ::field.literal [:tuple [:= :field] ::field.literal.options ::common/non-blank-string]) |
(mr/def ::field.id [:tuple [:= :field] ::field.options ; TODO -- we should make `:base-type` required here too ::id/field]) | |
(mbql-clause/define-mbql-clause :field
[:and
[:tuple
[:= :field]
::field.options
[:or ::id/field ::common/non-blank-string]]
[:multi {:dispatch (fn [clause]
;; apparently it still tries to dispatch when humanizing errors even if the `:tuple`
;; schema above failed, so we need to check that this is actually a tuple here again.
(when (sequential? clause)
(let [[_field _opts id-or-name] clause]
(lib.dispatch/dispatch-value id-or-name))))
;; without this it gives us dumb messages like "Invalid dispatch value" if the dispatch function above
;; doesn't return something that matches.
:error/message "Invalid :field clause ID or name: must be a string or integer"}
[:dispatch-type/integer ::field.id]
[:dispatch-type/string ::field.literal]]]) | |
(lib.hierarchy/derive :field ::ref) | |
(defmethod expression/type-of-method :field
[[_tag opts _id-or-name]]
(or ((some-fn :effective-type :base-type) opts)
::expression/type.unknown)) | |
(mbql-clause/define-tuple-mbql-clause :expression ::common/non-blank-string) | |
(defmethod expression/type-of-method :expression
[[_tag opts _expression-name]]
(or ((some-fn :effective-type :base-type) opts)
::expression/type.unknown)) | |
(lib.hierarchy/derive :expression ::ref) | |
(mr/def ::aggregation-options
[:merge
::common/options
[:map
[:name {:optional true} ::common/non-blank-string]
[:display-name {:optional true} ::common/non-blank-string]
[:lib/source-name {:optional true} ::common/non-blank-string]]]) | |
(mbql-clause/define-mbql-clause :aggregation [:tuple [:= :aggregation] ::aggregation-options :string]) | |
(defmethod expression/type-of-method :aggregation
[[_tag opts _index]]
(or ((some-fn :effective-type :base-type) opts)
::expression/type.unknown)) | |
(lib.hierarchy/derive :aggregation ::ref) | |
(mbql-clause/define-tuple-mbql-clause :segment :- :type/Boolean #_segment-id [:schema [:ref ::id/segment]]) | |
(lib.hierarchy/derive :segment ::ref) | |
(mbql-clause/define-tuple-mbql-clause :metric :- ::expression/type.unknown #_metric-id [:schema [:ref ::id/metric]]) | |
(lib.hierarchy/derive :metric ::ref) | |
(mr/def ::ref
[:and
::mbql-clause/clause
[:fn
{:error/fn (fn [_ _]
(str "Valid reference, must be one of these clauses: "
(str/join ", " (sort (descendants @lib.hierarchy/hierarchy ::ref)))))}
(fn [[tag :as _clause]]
(lib.hierarchy/isa? tag ::ref))]]) | |
(ns metabase.lib.schema.template-tag (:require [malli.core :as mc] [metabase.lib.schema.common :as common] [metabase.lib.schema.id :as id] [metabase.mbql.schema :as mbql.s] [metabase.util.malli.registry :as mr])) | |
Schema for valid values of | (mr/def ::widget-type
(into
[:enum
;; this will be a nicer error message than Malli trying to list every single possible allowed type.
{:error/message "Valid template tag :widget-type"}
:none]
(keys mbql.s/parameter-types))) |
Schema for valid values of template tag | (mr/def ::type [:enum :snippet :card :dimension :number :text :date]) |
Things required by all template tag types. | (mr/def ::common
[:map
[:name ::common/non-blank-string]
[:display-name ::common/non-blank-string]
;; TODO -- `:id` is actually 100% required but we have a lot of tests that don't specify it because this constraint
;; wasn't previously enforced; we need to go in and fix those tests and make this non-optional
[:id {:optional true} [:or ::common/non-blank-string :uuid]]]) |
Stuff shared between the Field filter and raw value template tag schemas. | (mr/def ::value.common
[:merge
[:ref ::common]
[:map
;; default value for this parameter
[:default {:optional true} any?]
;; whether or not a value for this parameter is required in order to run the query
[:required {:optional true} :boolean]]]) |
Example: {:id "c20851c7-8a80-0ffa-8a99-ae636f0e9539" :name "date" :display-name "Date" :type :dimension, :dimension [:field 4 nil] :widget-type :date/all-options} | (mr/def ::field-filter
[:merge
[:ref ::value.common]
[:map
[:type [:= :dimension]]
[:dimension [:ref :mbql.clause/field]]
;; which type of widget the frontend should show for this Field Filter; this also affects which parameter types
;; are allowed to be specified for it.
[:widget-type [:ref ::widget-type]]
;; optional map to be appended to filter clause
[:options {:optional true} :map]]]) |
Example: {:id "c2fc7310-44eb-4f21-c3a0-63806ffb7ddd" :name "snippet: select" :display-name "Snippet: select" :type :snippet :snippet-name "select" :snippet-id 1} | (mr/def ::snippet
[:merge
[:ref ::common]
[:map
[:type [:= :snippet]]
[:snippet-name ::common/non-blank-string]
[:snippet-id {:optional true} ::id/snippet]
;; database to which this Snippet belongs. Doesn't always seem to be specified.
[:database {:optional true} ::id/database]]]) |
Example: {:id "fc5e14d9-7d14-67af-66b2-b2a6e25afeaf" :name "#1635" :display-name "#1635" :type :card :card-id 1635} | (mr/def ::source-query
[:merge
[:ref ::common]
[:map
[:type [:= :card]]
[:card-id ::id/card]]]) |
Valid values of | (mr/def ::raw-value.type (into [:enum] mbql.s/raw-value-template-tag-types)) |
Example: {:id "35f1ecd4-d622-6d14-54be-750c498043cb" :name "id" :display-name "Id" :type :number :required true :default "1"} | (mr/def ::raw-value
[:merge
[:ref ::value.common]
;; `:type` is used be the FE to determine which type of widget to display for the template tag, and to determine
;; which types of parameters are allowed to be passed in for this template tag.
[:map
[:type [:ref ::raw-value.type]]]]) |
(mr/def ::template-tag
[:and
[:map
[:type [:ref ::type]]]
[:multi {:dispatch :type}
[:dimension [:ref ::field-filter]]
[:snippet [:ref ::snippet]]
[:card [:ref ::source-query]]
;; :number, :text, :date
[::mc/default [:ref ::raw-value]]]]) | |
(mr/def ::template-tag-map
[:and
[:map-of ::common/non-blank-string [:ref ::template-tag]]
;; make sure people don't try to pass in a `:name` that's different from the actual key in the map.
[:fn
{:error/message "keys in template tag map must match the :name of their values"}
(fn [m]
(every? (fn [[tag-name tag-definition]]
(= tag-name (:name tag-definition)))
m))]]) | |
Malli schema for temporal bucketing units and expressions. | (ns metabase.lib.schema.temporal-bucketing (:require [clojure.set :as set] [metabase.util.malli.registry :as mr])) |
Units that you can EXTRACT from a date or datetime. These return integers in temporal bucketing expressions. The front end shows the options in this order. | (def ordered-date-extraction-units [:day-of-week :day-of-month :day-of-year :week-of-year :month-of-year :quarter-of-year :year :year-of-era]) |
Units that you can EXTRACT from a date or datetime. These return integers in temporal bucketing expressions. | (def date-extraction-units (set ordered-date-extraction-units)) |
(mr/def ::unit.date.extract
(into [:enum {:error/message "Valid date extraction unit"}] date-extraction-units)) | |
Units that you can TRUNCATE a date or datetime to. In temporal bucketing expressions these return a | (def ordered-date-truncation-units [:day :week :month :quarter :year]) |
Units that you can TRUNCATE a date or datetime to. In temporal bucketing expressions these return a | (def date-truncation-units (set ordered-date-truncation-units)) |
(mr/def ::unit.date.truncate
(into [:enum {:error/message "Valid date truncation unit"}] date-truncation-units)) | |
Valid date or datetime bucketing units for either truncation or extraction operations. The front end shows the options in this order. | (def ordered-date-bucketing-units (into [] (distinct) (concat ordered-date-truncation-units ordered-date-extraction-units))) |
Valid date or datetime bucketing units for either truncation or extraction operations. | (def date-bucketing-units (set ordered-date-bucketing-units)) |
(mr/def ::unit.date
(into [:enum {:error/message "Valid date bucketing unit"}] date-bucketing-units)) | |
Units that you can EXTRACT from a time or datetime. These return integers in temporal bucketing expressions. The front end shows the options in this order. | (def ordered-time-extraction-units [:second-of-minute :minute-of-hour :hour-of-day]) |
Units that you can EXTRACT from a time or datetime. These return integers in temporal bucketing expressions. | (def time-extraction-units (set ordered-time-extraction-units)) |
(mr/def ::unit.time.extract
(into [:enum {:error/message "Valid time extraction unit"}] time-extraction-units)) | |
Units you can TRUNCATE a time or datetime to. These return the same type as the expression being bucketed in temporal bucketing expressions. The front end shows the options in this order. | (def ordered-time-truncation-units [:millisecond :second :minute :hour]) |
Units you can TRUNCATE a time or datetime to. These return the same type as the expression being bucketed in temporal bucketing expressions. | (def time-truncation-units (set ordered-time-truncation-units)) |
(mr/def ::unit.time.truncate
(into [:enum {:error/message "Valid time truncation unit"}] time-truncation-units)) | |
Valid time bucketing units for either truncation or extraction operations. The front end shows the options in this order. | (def ordered-time-bucketing-units
(into []
(distinct)
(concat ordered-time-truncation-units ordered-time-extraction-units))) |
Valid time bucketing units for either truncation or extraction operations. | (def time-bucketing-units (set ordered-time-bucketing-units)) |
(mr/def ::unit.time
(into [:enum {:error/message "Valid time bucketing unit"}] time-bucketing-units)) | |
Valid datetime bucketing units for either truncation or extraction operations. The front end shows the options in this order. | (def ordered-datetime-bucketing-units
(into []
(distinct)
(concat ordered-time-truncation-units ordered-date-truncation-units
ordered-time-extraction-units ordered-date-extraction-units))) |
Valid datetime bucketing units for either truncation or extraction operations. | (def datetime-bucketing-units (set ordered-datetime-bucketing-units)) |
(mr/def ::unit.date-time
(into [:enum {:error/message "Valid datetime bucketing unit"}] ordered-datetime-bucketing-units)) | |
This is the same as [[datetime-bucketing-units]], but also includes | (def temporal-bucketing-units (conj datetime-bucketing-units :default)) |
(mr/def ::unit
(into [:enum {:error/message "Valid temporal bucketing unit"}] temporal-bucketing-units)) | |
Valid TRUNCATION units for a datetime. | (def datetime-truncation-units (set/union date-truncation-units time-truncation-units)) |
(mr/def ::unit.date-time.truncate
(into [:enum {:error/message "Valid datetime truncation unit"}] datetime-truncation-units)) | |
Valid EXTRACTION units for a datetime. Extraction units return integers! | (def datetime-extraction-units (set/union date-extraction-units time-extraction-units)) |
(mr/def ::unit.date-time.extract
(into [:enum {:error/message "Valid datetime extraction unit"}] datetime-extraction-units)) | |
Date units that are valid in intervals or clauses like | (def date-interval-units ;; it's the same but also includes `:year`, not normally allowed as a date truncation unit; `:year` is interpreted ;; as extraction instead. (conj date-truncation-units :year)) |
(mr/def ::unit.date.interval
(into [:enum {:error/message "Valid date interval unit"}] date-interval-units)) | |
Time units that are valid in intervals or clauses like | (def time-interval-units time-truncation-units) |
(mr/def ::unit.time.interval
(into [:enum {:error/message "Valid time interval unit"}] time-interval-units)) | |
Units valid in intervals or clauses like | (def datetime-interval-units (set/union date-interval-units time-interval-units)) |
(mr/def ::unit.date-time.interval
(into [:enum {:error/message "Valid datetime interval unit"}] datetime-interval-units)) | |
(mr/def ::option
[:map
[:lib/type [:= :option/temporal-bucketing]]
[:unit ::unit]
[:default {:optional true} :boolean]]) | |
(ns metabase.lib.schema.util (:refer-clojure :exclude [ref]) (:require [metabase.lib.options :as lib.options])) | |
(declare collect-uuids) | |
(defn- collect-uuids-in-map [m]
(into (if-let [our-uuid (or (:lib/uuid (lib.options/options m))
(:lib/uuid m))]
[our-uuid]
[])
(comp (remove (fn [[k _v]]
(#{:lib/metadata :lib/stage-metadata :lib/options} k)))
(mapcat (fn [[_k v]]
(collect-uuids v))))
m)) | |
(defn- collect-uuids-in-sequence [xs] (into [] (mapcat collect-uuids) xs)) | |
Return all the | (defn collect-uuids
[x]
(cond
(map? x) (collect-uuids-in-map x)
(sequential? x) (collect-uuids-in-sequence x)
:else nil)) |
(defn- find-duplicate-uuid [x]
(transduce
identity
(fn
([]
#{})
([result]
(when (string? result)
result))
([seen a-uuid]
(if (contains? seen a-uuid)
(reduced a-uuid)
(conj seen a-uuid))))
(collect-uuids x))) | |
True if all the | (defn unique-uuids? [x] (not (find-duplicate-uuid x))) |
Malli schema for to ensure that all | (def UniqueUUIDs
[:fn
{:error/message "all :lib/uuids must be unique"
:error/fn (fn [{:keys [value]} _]
(str "Duplicate :lib/uuid " (pr-str (find-duplicate-uuid value))))}
#'unique-uuids?]) |
Remove all the namespaced keys from a map. | (defn remove-namespaced-keys
[m]
(into {} (remove (fn [[k _v]] (qualified-keyword? k))) m)) |
Is a sequence of | (defn distinct-refs?
[refs]
(or
(< (count refs) 2)
(apply
distinct?
(for [ref refs]
(lib.options/update-options ref (fn [options]
(-> options
remove-namespaced-keys
(dissoc :base-type :effective-type)))))))) |
A Segment is a saved MBQL query stage snippet with | (ns metabase.lib.segment (:require [metabase.lib.filter :as lib.filter] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.metadata.protocols :as lib.metadata.protocols] [metabase.lib.options :as lib.options] [metabase.lib.ref :as lib.ref] [metabase.lib.schema :as lib.schema] [metabase.lib.util :as lib.util] [metabase.shared.util.i18n :as i18n] [metabase.util.malli :as mu])) |
(defn- resolve-segment [query segment-id]
(when (integer? segment-id)
(lib.metadata/segment query segment-id))) | |
(defmethod lib.ref/ref-method :metadata/segment
[{:keys [id]}]
(lib.options/ensure-uuid [:segment {} id])) | |
(defmethod lib.metadata.calculation/type-of-method :metadata/segment [_query _stage-number _metric-metadata] :type/Boolean) | |
(defmethod lib.metadata.calculation/type-of-method :segment [_query _stage-number _segment-clause] :type/Boolean) | |
(defn- fallback-display-name [] (i18n/tru "[Unknown Segment]")) | |
(defmethod lib.metadata.calculation/display-name-method :metadata/segment
[_query _stage-number segment-metadata _style]
(or (:display-name segment-metadata)
(:name segment-metadata)
(fallback-display-name))) | |
(defmethod lib.metadata.calculation/display-name-method :segment
[query stage-number [_tag _opts segment-id-or-name] style]
(or (when (integer? segment-id-or-name)
(when-let [segment-metadata (lib.metadata/segment query segment-id-or-name)]
(lib.metadata.calculation/display-name query stage-number segment-metadata style)))
(fallback-display-name))) | |
(defmethod lib.metadata.calculation/display-info-method :metadata/segment
[query stage-number {:keys [description filter-positions], :as segment-metadata}]
(let [default-display-info-method (get-method lib.metadata.calculation/display-info-method :default)
default-display-info (default-display-info-method query stage-number segment-metadata)]
(cond-> default-display-info
description (assoc :description description)
filter-positions (assoc :filter-positions filter-positions)))) | |
(defmethod lib.metadata.calculation/display-info-method :segment
[query stage-number [_tag _opts segment-id-or-name]]
(if-let [segment-metadata (resolve-segment query segment-id-or-name)]
(lib.metadata.calculation/display-info query stage-number segment-metadata)
{:effective-type :type/Boolean
:display-name (fallback-display-name)
:long-display-name (fallback-display-name)})) | |
(mu/defn available-segments :- [:maybe [:sequential {:min 1} lib.metadata/SegmentMetadata]]
"Get a list of Segments that you may consider using as filter for a query. Only Segments that have the same
`table-id` as the `source-table` for this query will be suggested."
([query]
(available-segments query -1))
([query :- ::lib.schema/query
stage-number :- :int]
(when (zero? (lib.util/canonical-stage-index query stage-number))
(when-let [source-table-id (lib.util/source-table-id query)]
(let [segments (lib.metadata.protocols/segments (lib.metadata/->metadata-provider query) source-table-id)
segment-filters (into {}
(keep-indexed (fn [index filter-clause]
(when (lib.util/clause-of-type? filter-clause :segment)
[(get filter-clause 2) index])))
(lib.filter/filters query 0))]
(cond
(empty? segments) nil
(empty? segment-filters) (vec segments)
:else (mapv (fn [segment-metadata]
(let [filter-pos (-> segment-metadata :id segment-filters)]
(cond-> segment-metadata
;; even though at most one filter can reference a given segment
;; we use plural in order to keep the interface used with
;; plain filters referencing columns
filter-pos (assoc :filter-positions [filter-pos]))))
segments))))))) | |
Method implementations for a stage of a query. | (ns metabase.lib.stage (:require [clojure.string :as str] [medley.core :as m] [metabase.lib.aggregation :as lib.aggregation] [metabase.lib.breakout :as lib.breakout] [metabase.lib.expression :as lib.expression] [metabase.lib.field :as lib.field] [metabase.lib.hierarchy :as lib.hierarchy] [metabase.lib.join :as lib.join] [metabase.lib.join.util :as lib.join.util] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.normalize :as lib.normalize] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.id :as lib.schema.id] [metabase.lib.util :as lib.util] [metabase.shared.util.i18n :as i18n] [metabase.util :as u] [metabase.util.malli :as mu])) |
(lib.hierarchy/derive :mbql.stage/mbql ::stage) (lib.hierarchy/derive :mbql.stage/native ::stage) | |
(defmethod lib.normalize/normalize :mbql.stage/mbql
[stage]
(lib.normalize/normalize-map
stage
keyword
{:aggregation (partial mapv lib.normalize/normalize)
:filters (partial mapv lib.normalize/normalize)})) | |
(defmethod lib.metadata.calculation/metadata-method ::stage
[_query _stage-number _stage]
;; not i18n'ed because this shouldn't be developer-facing.
(throw (ex-info "You can't calculate a metadata map for a stage! Use lib.metadata.calculation/returned-columns-method instead."
{}))) | |
(mu/defn ensure-previous-stages-have-metadata :- ::lib.schema/query
"Recursively calculate the metadata for the previous stages and add it to them, we'll need it for metadata
calculations for [[lib.metadata.calculation/returned-columns]] and [[lib.metadata.calculation/visible-columns]], and
we don't want to have to calculate it more than once..."
[query :- ::lib.schema/query
stage-number :- :int]
(reduce
(fn [query stage-number]
(lib.util/update-query-stage query
stage-number
assoc ::cached-metadata
(lib.metadata.calculation/returned-columns query
stage-number
(lib.util/query-stage query stage-number))))
query
(range 0 (lib.util/canonical-stage-index query stage-number)))) | |
(mu/defn ^:private existing-stage-metadata :- [:maybe lib.metadata.calculation/ColumnsWithUniqueAliases]
"Return existing stage metadata attached to a stage if is already present: return it as-is, but only if this is a
native stage or a source-Card stage. if it's any other sort of stage then ignore the metadata, it's probably wrong;
we can recalculate the correct metadata anyway."
[query :- ::lib.schema/query
stage-number :- :int]
(let [{stage-type :lib/type, :keys [source-card] :as stage} (lib.util/query-stage query stage-number)]
(or (::cached-metadata stage)
(when-let [metadata (:lib/stage-metadata stage)]
(when (or (= stage-type :mbql.stage/native)
source-card)
(let [source-type (case stage-type
:mbql.stage/native :source/native
:mbql.stage/mbql :source/card)]
(not-empty
(for [col (:columns metadata)]
(merge
{:lib/source-column-alias (:name col)
:lib/desired-column-alias (:name col)}
col
{:lib/source source-type}))))))))) | |
(mu/defn ^:private breakouts-columns :- [:maybe lib.metadata.calculation/ColumnsWithUniqueAliases]
[query :- ::lib.schema/query
stage-number :- :int
unique-name-fn :- fn?]
(not-empty
(for [breakout (lib.breakout/breakouts-metadata query stage-number)]
(assoc breakout
:lib/source :source/breakouts
:lib/source-column-alias ((some-fn :lib/source-column-alias :name) breakout)
:lib/desired-column-alias (unique-name-fn (lib.join.util/desired-alias query breakout)))))) | |
(mu/defn ^:private aggregations-columns :- [:maybe lib.metadata.calculation/ColumnsWithUniqueAliases]
[query :- ::lib.schema/query
stage-number :- :int
unique-name-fn :- fn?]
(not-empty
(for [ag (lib.aggregation/aggregations-metadata query stage-number)]
(assoc ag
:lib/source :source/aggregations
:lib/source-column-alias (:name ag)
:lib/desired-column-alias (unique-name-fn (:name ag)))))) | |
TODO -- maybe the bulk of this logic should be moved into [[metabase.lib.field]], like we did for breakouts and aggregations above. | (mu/defn ^:private fields-columns :- [:maybe lib.metadata.calculation/ColumnsWithUniqueAliases]
[query :- ::lib.schema/query
stage-number :- :int
unique-name-fn :- fn?]
(when-let [{fields :fields} (lib.util/query-stage query stage-number)]
(not-empty
(for [[tag :as ref-clause] fields
:let [source (case tag
;; you can't have an `:aggregation` reference in `:fields`; anything in
;; `:aggregations` is returned automatically anyway
;; by [[aggregations-columns]] above.
:field :source/fields
:expression :source/expressions)
metadata (lib.metadata.calculation/metadata query stage-number ref-clause)]]
(assoc metadata
:lib/source source
:lib/source-column-alias (lib.metadata.calculation/column-name query stage-number metadata)
:lib/desired-column-alias (unique-name-fn (lib.join.util/desired-alias query metadata))))))) |
(mu/defn ^:private summary-columns :- [:maybe lib.metadata.calculation/ColumnsWithUniqueAliases]
[query :- ::lib.schema/query
stage-number :- :int
unique-name-fn :- fn?]
(not-empty
(into []
(mapcat (fn [f]
(f query stage-number unique-name-fn)))
[breakouts-columns
aggregations-columns]))) | |
(mu/defn ^:private previous-stage-metadata :- [:maybe lib.metadata.calculation/ColumnsWithUniqueAliases]
"Metadata for the previous stage, if there is one."
[query :- ::lib.schema/query
stage-number :- :int
unique-name-fn :- fn?]
(when-let [previous-stage-number (lib.util/previous-stage-number query stage-number)]
(not-empty
(for [col (lib.metadata.calculation/returned-columns query
previous-stage-number
(lib.util/query-stage query previous-stage-number))
:let [source-alias (or ((some-fn :lib/desired-column-alias :lib/source-column-alias) col)
(lib.metadata.calculation/column-name query stage-number col))]]
(-> (merge
col
{:lib/source :source/previous-stage
:lib/source-column-alias source-alias
:lib/desired-column-alias (unique-name-fn source-alias)}
(when (:metabase.lib.card/force-broken-id-refs col)
(select-keys col [:metabase.lib.card/force-broken-id-refs])))
;; do not retain `:temporal-unit`; it's not like we're doing a extract(month from <x>) twice, in both
;; stages of a query. It's a little hacky that we're manipulating `::lib.field` keys directly here since
;; they're presumably supposed to be private-ish, but I don't have a more elegant way of solving this sort
;; of problem at this point in time.
;;
;; also don't retain `:lib/expression-name`, the fact that this column came from an expression in the
;; previous stage should be totally irrelevant and we don't want it confusing our code that decides whether
;; to generate `:expression` or `:field` refs.
(dissoc ::lib.field/temporal-unit :lib/expression-name)))))) | |
(mu/defn ^:private saved-question-metadata :- [:maybe lib.metadata.calculation/ColumnsWithUniqueAliases]
"Metadata associated with a Saved Question, e.g. if we have a `:source-card`"
[query :- ::lib.schema/query
stage-number :- :int
card-id :- [:maybe ::lib.schema.id/card]
options :- lib.metadata.calculation/VisibleColumnsOptions]
(when card-id
(when-let [card (lib.metadata/card query card-id)]
(not-empty (lib.metadata.calculation/visible-columns query stage-number card options))))) | |
(mu/defn ^:private expressions-metadata :- [:maybe lib.metadata.calculation/ColumnsWithUniqueAliases]
[query :- ::lib.schema/query
stage-number :- :int
unique-name-fn :- fn?]
(not-empty
(for [expression (lib.expression/expressions-metadata query stage-number)]
(let [base-type (:base-type expression)]
(-> (assoc expression
:lib/source :source/expressions
:lib/source-column-alias (:name expression)
:lib/desired-column-alias (unique-name-fn (:name expression)))
(u/assoc-default :effective-type (or base-type :type/*))))))) | |
Calculate the columns to return if Formula for the so-called 'default' columns is 1a. Columns returned by the previous stage of the query (if there is one), OR 1b. Default 'visible' Fields for our 1c. Metadata associated with a Saved Question, if we have 1d. PLUS
PLUS
| (mu/defn ^:private previous-stage-or-source-visible-columns :- lib.metadata.calculation/ColumnsWithUniqueAliases
"Return columns from the previous query stage or source Table/Card."
[query :- ::lib.schema/query
stage-number :- :int
{:keys [unique-name-fn], :as options} :- lib.metadata.calculation/VisibleColumnsOptions]
{:pre [(fn? unique-name-fn)]}
(mapv
#(dissoc % ::lib.join/join-alias ::lib.field/temporal-unit ::lib.field/binning :fk-field-id)
(or
;; 1a. columns returned by previous stage
(previous-stage-metadata query stage-number unique-name-fn)
;; 1b or 1c
(let [{:keys [source-table source-card], :as this-stage} (lib.util/query-stage query stage-number)]
(or
;; 1b: default visible Fields for the source Table
(when source-table
(assert (integer? source-table))
(let [table-metadata (lib.metadata/table query source-table)]
(lib.metadata.calculation/visible-columns query stage-number table-metadata options)))
;; 1c. Metadata associated with a saved Question
(when source-card
(saved-question-metadata query stage-number source-card (assoc options :include-implicitly-joinable? false)))
;; 1d: `:lib/stage-metadata` for the (presumably native) query
(for [col (:columns (:lib/stage-metadata this-stage))]
(assoc col
:lib/source :source/native
:lib/source-column-alias (:name col)
;; these should already be unique, but run them thru `unique-name-fn` anyway to make sure anything
;; that gets added later gets deduplicated from these.
:lib/desired-column-alias (unique-name-fn (:name col))))))))) |
(mu/defn ^:private existing-visible-columns :- lib.metadata.calculation/ColumnsWithUniqueAliases
[query :- ::lib.schema/query
stage-number :- :int
{:keys [unique-name-fn include-joined? include-expressions?], :as options} :- lib.metadata.calculation/VisibleColumnsOptions]
(concat
;; 1: columns from the previous stage, source table or query
(previous-stage-or-source-visible-columns query stage-number options)
;; 2: expressions (aka calculated columns) added in this stage
(when include-expressions?
(expressions-metadata query stage-number unique-name-fn))
;; 3: columns added by joins at this stage
(when include-joined?
(lib.join/all-joins-visible-columns query stage-number unique-name-fn)))) | |
(defmethod lib.metadata.calculation/visible-columns-method ::stage
[query stage-number _stage {:keys [unique-name-fn include-implicitly-joinable?], :as options}]
(let [query (ensure-previous-stages-have-metadata query stage-number)
existing-columns (existing-visible-columns query stage-number options)]
(->> (concat
existing-columns
;; add implicitly joinable columns if desired
(when (and include-implicitly-joinable?
(or (not (:source-card (lib.util/query-stage query stage-number)))
(:include-implicitly-joinable-for-source-card? options)))
(lib.metadata.calculation/implicitly-joinable-columns query stage-number existing-columns unique-name-fn)))
vec))) | |
Return results metadata about the expected columns in an MBQL query stage. If the query has aggregations/breakouts, then return those and the fields columns. Otherwise if there are fields columns return those and the joined columns. Otherwise return the defaults based on the source Table or previous stage + joins. | (defmethod lib.metadata.calculation/returned-columns-method ::stage
[query stage-number _stage {:keys [unique-name-fn], :as options}]
(or
(existing-stage-metadata query stage-number)
(let [query (ensure-previous-stages-have-metadata query stage-number)
summary-cols (summary-columns query stage-number unique-name-fn)
field-cols (fields-columns query stage-number unique-name-fn)]
;; ... then calculate metadata for this stage
(cond
summary-cols
(into summary-cols field-cols)
field-cols
(do (doall field-cols) ; force generation of unique names before join columns
(into []
(m/distinct-by #(dissoc % :source-alias :lib/source :lib/source-uuid :lib/desired-column-alias))
(concat field-cols
(lib.join/all-joins-expected-columns query stage-number options))))
:else
;; there is no `:fields` or summary columns (aggregtions or breakouts) which means we return all the visible
;; columns from the source or previous stage plus all the expressions. We return only the `:fields` from any
;; joins
(concat
;; we don't want to include all visible joined columns, so calculate that separately
(previous-stage-or-source-visible-columns query stage-number {:include-implicitly-joinable? false
:unique-name-fn unique-name-fn})
(expressions-metadata query stage-number unique-name-fn)
(lib.join/all-joins-expected-columns query stage-number options)))))) |
(defmethod lib.metadata.calculation/display-name-method :mbql.stage/native [_query _stage-number _stage _style] (i18n/tru "Native query")) | |
(def ^:private display-name-source-parts [:source-table :source-card :joins]) | |
(def ^:private display-name-other-parts [:aggregation :breakout :filters :order-by :limit]) | |
(defmethod lib.metadata.calculation/display-name-method :mbql.stage/mbql
[query stage-number _stage style]
(let [query (ensure-previous-stages-have-metadata query stage-number)]
(or
(not-empty
(let [part->description (into {}
(comp cat
(map (fn [k]
[k (lib.metadata.calculation/describe-top-level-key query stage-number k)])))
[display-name-source-parts display-name-other-parts])
source-description (str/join " + " (remove str/blank? (map part->description display-name-source-parts)))
other-descriptions (map part->description display-name-other-parts)]
(str/join ", " (remove str/blank? (cons source-description other-descriptions)))))
(when-let [previous-stage-number (lib.util/previous-stage-number query stage-number)]
(lib.metadata.calculation/display-name query
previous-stage-number
(lib.util/query-stage query previous-stage-number)
style))))) | |
(mu/defn has-clauses? :- :boolean "Does given query stage have any clauses?" [query :- ::lib.schema/query stage-number :- :int] (boolean (seq (dissoc (lib.util/query-stage query stage-number) :lib/type :source-table :source-card)))) | |
(mu/defn append-stage :- ::lib.schema/query
"Adds a new blank stage to the end of the pipeline"
[query]
(update query :stages conj {:lib/type :mbql.stage/mbql})) | |
(mu/defn drop-stage :- ::lib.schema/query
"Drops the final stage in the pipeline, will no-op if it is the only stage"
[query]
(if (= 1 (count (:stages query)))
query
(update query :stages pop))) | |
(mu/defn drop-stage-if-empty :- ::lib.schema/query
"Drops the final stage in the pipeline IF the stage is empty of clauses, otherwise no-op"
[query :- ::lib.schema/query]
(if-not (has-clauses? query -1)
(drop-stage query)
query)) | |
(ns metabase.lib.table (:require [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.util :as lib.util] [metabase.shared.util.i18n :as i18n] [metabase.util :as u] [metabase.util.humanization :as u.humanization])) | |
(defmethod lib.metadata.calculation/display-name-method :metadata/table
[_query _stage-number table-metadata _style]
(or (:display-name table-metadata)
(some->> (:name table-metadata)
(u.humanization/name->human-readable-name :simple)))) | |
(defmethod lib.metadata.calculation/metadata-method :metadata/table [_query _stage-number table-metadata] table-metadata) | |
(defmethod lib.metadata.calculation/describe-top-level-key-method :source-table
[query stage-number _k]
(let [{:keys [source-table]} (lib.util/query-stage query stage-number)]
(when source-table
(assert (integer? source-table)
(i18n/tru "Unexpected source table ID {0}" (pr-str source-table)))
(or (when-let [table-metadata (lib.metadata/table query source-table)]
(lib.metadata.calculation/display-name query stage-number table-metadata :long))
(i18n/tru "Table {0}" (pr-str source-table)))))) | |
Remove Fields that shouldn't be visible from the default Fields for a source Table. See [[metabase.query-processor.middleware.add-implicit-clauses/table->sorted-fields*]]. | (defn- remove-hidden-default-fields
[field-metadatas]
(remove (fn [{:keys [visibility-type], active? :active, :as _field-metadata}]
(or (false? active?)
(#{:sensitive :retired} (some-> visibility-type keyword))))
field-metadatas)) |
Sort default Fields for a source Table. See [[metabase.models.table/field-order-rule]]. | (defn- sort-default-fields
[field-metadatas]
(sort-by (fn [{field-name :name, :keys [position], :as _field-metadata}]
[(or position 0) (u/lower-case-en (or field-name ""))])
field-metadatas)) |
(defmethod lib.metadata.calculation/returned-columns-method :metadata/table
[query _stage-number table-metadata {:keys [unique-name-fn], :as _options}]
(when-let [field-metadatas (lib.metadata/fields query (:id table-metadata))]
(->> field-metadatas
remove-hidden-default-fields
sort-default-fields
(map (fn [col]
(assoc col
:lib/source :source/table-defaults
:lib/source-column-alias (:name col)
:lib/desired-column-alias (unique-name-fn (or (:name col) "")))))))) | |
(ns metabase.lib.temporal-bucket
(:require
[clojure.string :as str]
[metabase.lib.dispatch :as lib.dispatch]
[metabase.lib.hierarchy :as lib.hierarchy]
[metabase.lib.metadata.calculation :as lib.metadata.calculation]
[metabase.lib.schema :as lib.schema]
[metabase.lib.schema.common :as lib.schema.common]
[metabase.lib.schema.temporal-bucketing
:as lib.schema.temporal-bucketing]
[metabase.shared.util.i18n :as i18n]
[metabase.shared.util.time :as shared.ut]
[metabase.util :as u]
[metabase.util.malli :as mu])) | |
(mu/defn describe-temporal-unit :- :string
"Get a translated description of a temporal bucketing unit."
([]
(describe-temporal-unit 1 nil))
([unit]
(describe-temporal-unit 1 unit))
([n :- :int
unit :- [:maybe :keyword]]
(if-not unit
(let [n (abs n)]
(case (keyword unit)
:default (i18n/trun "Default period" "Default periods" n)
:millisecond (i18n/trun "Millisecond" "Milliseconds" n)
:second (i18n/trun "Second" "Seconds" n)
:minute (i18n/trun "Minute" "Minutes" n)
:hour (i18n/trun "Hour" "Hours" n)
:day (i18n/trun "Day" "Days" n)
:week (i18n/trun "Week" "Weeks" n)
:month (i18n/trun "Month" "Months" n)
:quarter (i18n/trun "Quarter" "Quarters" n)
:year (i18n/trun "Year" "Years" n)
:minute-of-hour (i18n/trun "Minute of hour" "Minutes of hour" n)
:hour-of-day (i18n/trun "Hour of day" "Hours of day" n)
:day-of-week (i18n/trun "Day of week" "Days of week" n)
:day-of-month (i18n/trun "Day of month" "Days of month" n)
:day-of-year (i18n/trun "Day of year" "Days of year" n)
:week-of-year (i18n/trun "Week of year" "Weeks of year" n)
:month-of-year (i18n/trun "Month of year" "Months of year" n)
:quarter-of-year (i18n/trun "Quarter of year" "Quarters of year" n)
;; e.g. :unknown-unit => "Unknown unit"
(let [[unit & more] (str/split (name unit) #"-")]
(str/join \space (cons (str/capitalize unit) more)))))))) | |
(def ^:private TemporalIntervalAmount [:or [:enum :current :last :next] :int]) | |
(defn- interval-n->int [n]
(if (number? n)
n
(case n
:current 0
:next 1
:last -1
0))) | |
(mu/defn describe-temporal-interval :- ::lib.schema.common/non-blank-string
"Get a translated description of a temporal bucketing interval. If unit is unspecified, assume `:day`."
[n :- TemporalIntervalAmount
unit :- [:maybe :keyword]]
(let [n (interval-n->int n)
unit (or unit :day)]
(cond
(zero? n) (if (= unit :day)
(i18n/tru "Today")
(i18n/tru "This {0}" (describe-temporal-unit unit)))
(= n 1) (if (= unit :day)
(i18n/tru "Tomorrow")
(i18n/tru "Next {0}" (describe-temporal-unit unit)))
(= n -1) (if (= unit :day)
(i18n/tru "Yesterday")
(i18n/tru "Previous {0}" (describe-temporal-unit unit)))
(neg? n) (i18n/tru "Previous {0} {1}" (abs n) (describe-temporal-unit (abs n) unit))
(pos? n) (i18n/tru "Next {0} {1}" n (describe-temporal-unit n unit))))) | |
(mu/defn describe-relative-datetime :- ::lib.schema.common/non-blank-string
"Get a translated description of a relative datetime interval, ported from
`frontend/src/metabase-lib/queries/utils/query-time.js`.
e.g. if the relative interval is `-1 days`, then `n` = `-1` and `unit` = `:day`.
If `:unit` is unspecified, assume `:day`."
[n :- TemporalIntervalAmount
unit :- [:maybe :keyword]]
(let [n (interval-n->int n)
unit (or unit :day)]
(cond
(zero? n)
(i18n/tru "Now")
(neg? n)
;; this should legitimately be lowercasing in the user locale. I know system locale isn't necessarily the same
;; thing, but it might be. This will have to do until we have some sort of user-locale lower-case functionality
#_ {:clj-kondo/ignore [:discouraged-var]}
(i18n/tru "{0} {1} ago" (abs n) (str/lower-case (describe-temporal-unit (abs n) unit)))
:else
#_ {:clj-kondo/ignore [:discouraged-var]}
(i18n/tru "{0} {1} from now" n (str/lower-case (describe-temporal-unit n unit)))))) | |
Implementation for [[temporal-bucket]]. Implement this to tell [[temporal-bucket]] how to add a bucket to a particular MBQL clause. | (defmulti with-temporal-bucket-method
{:arglists '([x unit])}
(fn [x _unit]
(lib.dispatch/dispatch-value x))
:hierarchy lib.hierarchy/hierarchy) |
Add a temporal bucketing unit, e.g. (temporal some-field :day) => [:field 1 {:temporal-unit :day}] Pass a | (mu/defn with-temporal-bucket
[x option-or-unit :- [:maybe [:or
::lib.schema.temporal-bucketing/option
::lib.schema.temporal-bucketing/unit]]]
(with-temporal-bucket-method x (cond-> option-or-unit
(not (keyword? option-or-unit)) :unit))) |
Implementation of [[temporal-bucket]]. Return the current temporal bucketing unit associated with | (defmulti temporal-bucket-method
{:arglists '([x])}
lib.dispatch/dispatch-value
:hierarchy lib.hierarchy/hierarchy) |
(defmethod temporal-bucket-method :default [_x] nil) | |
(mu/defmethod temporal-bucket-method :option/temporal-bucketing :- ::lib.schema.temporal-bucketing/unit [option] (:unit option)) | |
(mu/defn raw-temporal-bucket :- [:maybe ::lib.schema.temporal-bucketing/unit] "Get the raw temporal bucketing `unit` associated with something e.g. a `:field` ref or a ColumnMetadata." [x] (temporal-bucket-method x)) | |
(mu/defn temporal-bucket :- [:maybe ::lib.schema.temporal-bucketing/option]
"Get the current temporal bucketing option associated with something, if any."
[x]
(when-let [unit (raw-temporal-bucket x)]
{:lib/type :option/temporal-bucketing
:unit unit})) | |
Options that are technically legal in MBQL, but that should be hidden in the UI. | (def ^:private hidden-bucketing-options
#{:millisecond
:second
:second-of-minute
:year-of-era}) |
The temporal bucketing options for time type expressions. | (def time-bucket-options
(into []
(comp (remove hidden-bucketing-options)
(map (fn [unit]
(cond-> {:lib/type :option/temporal-bucketing
:unit unit}
(= unit :hour) (assoc :default true)))))
lib.schema.temporal-bucketing/ordered-time-bucketing-units)) |
The temporal bucketing options for date type expressions. | (def date-bucket-options
(mapv (fn [unit]
(cond-> {:lib/type :option/temporal-bucketing
:unit unit}
(= unit :day) (assoc :default true)))
lib.schema.temporal-bucketing/ordered-date-bucketing-units)) |
The temporal bucketing options for datetime type expressions. | (def datetime-bucket-options
(into []
(comp (remove hidden-bucketing-options)
(map (fn [unit]
(cond-> {:lib/type :option/temporal-bucketing
:unit unit}
(= unit :day) (assoc :default true)))))
lib.schema.temporal-bucketing/ordered-datetime-bucketing-units)) |
(defmethod lib.metadata.calculation/display-name-method :option/temporal-bucketing
[_query _stage-number {:keys [unit]} _style]
(describe-temporal-unit unit)) | |
(defmethod lib.metadata.calculation/display-info-method :option/temporal-bucketing
[query stage-number option]
(merge {:display-name (lib.metadata.calculation/display-name query stage-number option)
:short-name (u/qualified-name (raw-temporal-bucket option))
:is-temporal-extraction (contains? lib.schema.temporal-bucketing/datetime-extraction-units
(raw-temporal-bucket option))}
(select-keys option [:default :selected]))) | |
Implementation for [[available-temporal-buckets]]. Return a set of units from
| (defmulti available-temporal-buckets-method
{:arglists '([query stage-number x])}
(fn [_query _stage-number x]
(lib.dispatch/dispatch-value x))
:hierarchy lib.hierarchy/hierarchy) |
(defmethod available-temporal-buckets-method :default
[_query _stage-number _x]
#{}) | |
(mu/defn available-temporal-buckets :- [:sequential [:ref ::lib.schema.temporal-bucketing/option]]
"Get a set of available temporal bucketing units for `x`. Returns nil if no units are available."
([query x]
(available-temporal-buckets query -1 x))
([query :- ::lib.schema/query
stage-number :- :int
x]
(available-temporal-buckets-method query stage-number x))) | |
(mu/defn describe-temporal-pair :- :string
"Return a string describing the temporal pair.
Used when comparing temporal values like `[:!= ... [:field {:temporal-unit :day-of-week} ...] \"2022-01-01\"]`"
[temporal-column
temporal-value :- [:or :int :string]]
(shared.ut/format-unit temporal-value (:unit (temporal-bucket temporal-column)))) | |
Ported from frontend/src/metabase-lib/types/utils/isa.js | (ns metabase.lib.types.isa (:refer-clojure :exclude [isa? any? boolean? number? string? integer?]) (:require [medley.core :as m] [metabase.lib.types.constants :as lib.types.constants] [metabase.lib.util :as lib.util] [metabase.types])) |
(comment metabase.types/keep-me) | |
Decide if | (defn ^:export isa?
[{:keys [effective-type base-type semantic-type] :as _column} type-kw]
(or (clojure.core/isa? (or effective-type base-type) type-kw)
(clojure.core/isa? semantic-type type-kw))) |
Returns if | (defn ^:export field-type?
[category column]
(let [type-definition (lib.types.constants/type-hierarchies category)
column (cond-> column
(and (map? column)
(not (:effective-type column)))
(assoc :effective-type (:base-type column)))]
(cond
(nil? column) false
;; check field types
(some (fn [[type-type types]]
(and (#{:effective-type :semantic-type} type-type)
(some #(clojure.core/isa? (type-type column) %) types)))
type-definition)
true
;; recursively check if it's not an excluded type
(some #(field-type? % column) (:exclude type-definition))
false
;; recursively check if it's an included type
(some #(field-type? % column) (:include type-definition))
true
:else false))) |
Return the category | (defn ^:export field-type
[column]
(m/find-first #(field-type? % column)
[::lib.types.constants/temporal
::lib.types.constants/location
::lib.types.constants/coordinate
::lib.types.constants/foreign_key
::lib.types.constants/primary_key
::lib.types.constants/boolean
::lib.types.constants/string
::lib.types.constants/string_like
::lib.types.constants/number])) |
Is | (defn ^:export temporal? [column] (field-type? ::lib.types.constants/temporal column)) |
Is | (defn ^:export numeric? [column] (field-type? ::lib.types.constants/number column)) |
Is | (defn ^:export boolean? [column] (field-type? ::lib.types.constants/boolean column)) |
Is | (defn ^:export string? [column] (field-type? ::lib.types.constants/string column)) |
Is | (defn ^:export summable? [column] (field-type? ::lib.types.constants/summable column)) |
Is | (defn ^:export scope? [column] (field-type? ::lib.types.constants/scope column)) |
Is | (defn ^:export category? [column] (field-type? ::lib.types.constants/category column)) |
Is | (defn ^:export location? [column] (field-type? ::lib.types.constants/location column)) |
Is | (defn ^:export description? [column] (clojure.core/isa? (:semantic-type column) :type/Description)) |
Is | (defn ^:export dimension?
[column]
(and column
(not= (:lib/source column) :source/aggregations)
(not (description? column)))) |
Is | (defn ^:export metric?
[column]
(and (not= (:lib/source column) :source/breakouts)
(summable? column))) |
Is | (defn ^:export foreign-key? [column] (clojure.core/isa? (:semantic-type column) :type/FK)) |
Is | (defn ^:export primary-key? [column] (clojure.core/isa? (:semantic-type column) :type/PK)) |
Is | (defn ^:export entity-name? [column] (clojure.core/isa? (:semantic-type column) :type/Name)) |
Is | (defn ^:export title? [column] (clojure.core/isa? (:semantic-type column) :type/Title)) |
Is | (defn ^:export json? [column] (clojure.core/isa? (:semantic-type column) :type/SerializedJSON)) |
Is | (defn ^:export xml? [column] (clojure.core/isa? (:semantic-type column) :type/XML)) |
Is | (defn ^:export structured? [column] (clojure.core/isa? (:semantic-type column) :type/Structured)) |
Is this | (defn ^:export any? [_column] true) |
Is | (defn ^:export numeric-base-type? [column] (clojure.core/isa? (:effective-type column) :type/Number)) |
Is | (defn ^:export date-without-time? [column] (clojure.core/isa? (:effective-type column) :type/Date)) |
Is | (defn ^:export creation-timestamp? [column] (clojure.core/isa? (:semantic-type column) :type/CreationTimestamp)) |
Is | (defn ^:export creation-date? [column] (clojure.core/isa? (:semantic-type column) :type/CreationDate)) |
Is | (defn ^:export creation-time? [column] (clojure.core/isa? (:semantic-type column) :type/CreationTime)) |
Is ZipCode, ID, etc derive from Number but should not be formatted as numbers | (defn ^:export number?
[column]
(and (numeric-base-type? column)
(let [semantic-type (:semantic-type column)]
(or (nil? semantic-type)
;; this is a precaution, :type/Number is not a semantic type
(clojure.core/isa? semantic-type :type/Number))))) |
Is | (defn ^:export integer? [column] (field-type? ::lib.types.constants/integer column)) |
Is | (defn ^:export time? [column] (clojure.core/isa? (:effective-type column) :type/Time)) |
Is | (defn ^:export address? [column] (clojure.core/isa? (:semantic-type column) :type/Address)) |
Is | (defn ^:export city? [column] (clojure.core/isa? (:semantic-type column) :type/City)) |
Is | (defn ^:export state? [column] (clojure.core/isa? (:semantic-type column) :type/State)) |
Is | (defn ^:export zip-code? [column] (clojure.core/isa? (:semantic-type column) :type/ZipCode)) |
Is | (defn ^:export country? [column] (clojure.core/isa? (:semantic-type column) :type/Country)) |
Is | (defn ^:export coordinate? [column] (clojure.core/isa? (:semantic-type column) :type/Coordinate)) |
Is | (defn ^:export latitude? [column] (clojure.core/isa? (:semantic-type column) :type/Latitude)) |
Is | (defn ^:export longitude? [column] (clojure.core/isa? (:semantic-type column) :type/Longitude)) |
Is | (defn ^:export currency? [column] (clojure.core/isa? (:semantic-type column) :type/Currency)) |
Is | (defn ^:export comment? [column] (clojure.core/isa? (:semantic-type column) :type/Comment)) |
Is | (defn ^:export id?
[column]
(or (clojure.core/isa? (:semantic-type column) :type/FK)
(clojure.core/isa? (:semantic-type column) :type/PK))) |
Is | (defn ^:export URL? [column] (clojure.core/isa? (:semantic-type column) :type/URL)) |
Is | (defn ^:export email? [column] (clojure.core/isa? (:semantic-type column) :type/Email)) |
Is | (defn ^:export avatar-URL? [column] (clojure.core/isa? (:semantic-type column) :type/AvatarURL)) |
Is | (defn ^:export image-URL? [column] (clojure.core/isa? (:semantic-type column) :type/ImageURL)) |
Does the collection | (defn ^:export has-latitude-and-longitude? [columns] (every? #(some % columns) [latitude? longitude?])) |
Return a prdicate for checking if a column is a primary key. | (defn ^:export primary-key-pred
[table-id]
(fn primary-key-pred-for-table-id [column]
(let [pk? (primary-key? column)]
;; comment from isa.js:
;; > FIXME: columns of nested questions at this moment miss table_id value
;; > which makes it impossible to match them with their tables that are nested cards
(if (lib.util/legacy-string-table-id->card-id table-id)
pk?
(and pk? (= (:table-id column) table-id)))))) |
Is this column one that we should show a search widget for (to search its values) in the QB filter UI? If so, we can
give it a TODO -- This stuff should probably use the constants in [[metabase.lib.types.constants]], however this logic isn't
supposed to include things with semantic type = Category which the | (defn searchable?
[{:keys [base-type effective-type]}]
;; For the time being we will consider something to be "searchable" if it's a text Field since the `starts-with`
;; filter that powers the search queries (see [[metabase.api.field/search-values]]) doesn't work on anything else
(let [column-type (or effective-type base-type)]
(or (clojure.core/isa? column-type :type/Text)
(clojure.core/isa? column-type :type/TextLike)))) |
Given two CLJS That's the case if both are from the same family (strings, numbers, temporal) or if the | (defn valid-filter-for?
[src-column dst-column]
(or
(and (string? src-column) (string? dst-column))
(and (number? src-column) (number? dst-column))
(and (temporal? src-column) (temporal? dst-column))
(clojure.core/isa? (:base-type src-column) (:base-type dst-column)))) |
Helpers for getting at "underlying" or "top-level" queries and columns. This logic is shared by a handful of things like drill-thrus. | (ns metabase.lib.underlying (:require [clojure.set :as set] [metabase.lib.aggregation :as lib.aggregation] [metabase.lib.breakout :as lib.breakout] [metabase.lib.equality :as lib.equality] [metabase.lib.field :as lib.field] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.calculation :as lib.metadata.calculation] [metabase.lib.ref :as lib.ref] [metabase.lib.schema :as lib.schema] [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.lib.util :as lib.util] [metabase.util.malli :as mu])) |
(mu/defn ^:private pop-until-aggregation-or-breakout :- [:maybe ::lib.schema/query]
"Strips off any trailing stages that do not contain aggregations.
If there are no such stages, returns nil."
[query :- ::lib.schema/query]
(if (and (empty? (lib.aggregation/aggregations query -1))
(empty? (lib.breakout/breakouts query -1)))
;; No aggregations or breakouts in the last stage, so pop it off and recur.
(let [popped (update query :stages pop)]
(when (seq (:stages popped))
(recur popped)))
query)) | |
(mu/defn top-level-query :- ::lib.schema/query
"Returns the \"top-level\" query for the given query.
That means dropping any trailing filters, fields, etc. to get back to the last stage that has an aggregation. If there
are no stages with aggregations, the original query is returned.
If the database does not support nested queries, this also returns the original."
[query :- ::lib.schema/query]
(or (when ((-> query lib.metadata/database :features) :nested-queries)
(pop-until-aggregation-or-breakout query))
query)) | |
(mu/defn top-level-column :- ::lib.schema.metadata/column
"Given a column, returns the \"top-level\" equivalent.
Top-level means to find the corresponding column in the [[top-level-query]], which requires walking back through the
stages finding the equivalent column at each one.
Returns nil if the column can't be traced back to the top-level query."
[query :- ::lib.schema/query
column :- ::lib.schema.metadata/column]
(let [top-query (top-level-query query)]
(if (= query top-query)
column ;; Unchanged if this is already a top-level query. That includes keeping the "superfluous" options!
(loop [query query
column column]
(if (= query top-query)
;; Once we've found it, rename superfluous options, because under normal circumstances you will not need
;; them. On the off chance you do need them, they'll still be available.
(set/rename-keys column {::lib.field/temporal-unit ::temporal-unit
::lib.field/binning ::binning})
(let [prev-cols (lib.metadata.calculation/returned-columns query -2 (lib.util/previous-stage query -1))
prev-col (lib.equality/find-matching-column query -2 (lib.ref/ref column) prev-cols)]
(when prev-col
(recur (update query :stages pop) prev-col)))))))) | |
Configures the logger system for Metabase. Sets up an in-memory logger in a ring buffer for showing in the UI. Other logging options are set in [[metabase.bootstrap]]: the context locator for log4j2 and ensuring log4j2 is the logger that clojure.tools.logging uses. | (ns metabase.logger
(:require
[amalloy.ring-buffer :refer [ring-buffer]]
[clj-time.coerce :as time.coerce]
[clj-time.format :as time.format]
#_{:clj-kondo/ignore [:discouraged-namespace]}
[clojure.tools.logging :as log]
[clojure.tools.logging.impl :as log.impl]
[metabase.config :as config]
[metabase.plugins.classloader :as classloader])
(:import
(java.lang AutoCloseable)
(org.apache.commons.lang3.exception ExceptionUtils)
(org.apache.logging.log4j LogManager Level)
(org.apache.logging.log4j.core Appender LogEvent Logger LoggerContext)
(org.apache.logging.log4j.core.appender AbstractAppender FileAppender OutputStreamAppender)
(org.apache.logging.log4j.core.config AbstractConfiguration Configuration LoggerConfig))) |
(set! *warn-on-reflection* true) | |
(def ^:private ^:const max-log-entries 2500) | |
(defonce ^:private messages* (atom (ring-buffer max-log-entries))) | |
Get the list of currently buffered log entries, from most-recent to oldest. | (defn messages [] (reverse (seq @messages*))) |
(defn- event->log-data [^LogEvent event]
{:timestamp (time.format/unparse (time.format/formatter :date-time)
(time.coerce/from-long (.getTimeMillis event)))
:level (.getLevel event)
:fqns (.getLoggerName event)
:msg (.getMessage event)
:exception (when-let [throwable (.getThrown event)]
(seq (ExceptionUtils/getStackFrames throwable)))
:process_uuid config/local-process-uuid}) | |
(defn- metabase-appender ^Appender []
(let [^org.apache.logging.log4j.core.Filter filter nil
^org.apache.logging.log4j.core.Layout layout nil
^"[Lorg.apache.logging.log4j.core.config.Property;" properties nil]
(proxy [org.apache.logging.log4j.core.appender.AbstractAppender]
["metabase-appender" filter layout false properties]
(append [event]
(swap! messages* conj (event->log-data event))
nil)))) | |
(defonce ^:private has-added-appender? (atom false)) | |
Get global logging context. | (defn context ^LoggerContext [] (LogManager/getContext (classloader/the-classloader) false)) |
Get global logging configuration | (defn configuration ^Configuration [] (.getConfiguration (context))) |
(when-not *compile-files*
(when-not @has-added-appender?
(reset! has-added-appender? true)
(let [appender (metabase-appender)
config (configuration)]
(.start appender)
(.addAppender config appender)
(doseq [[_ ^LoggerConfig logger-config] (.getLoggers config)]
(.addAppender logger-config appender (.getLevel logger-config) (.getFilter logger-config))
(.updateLoggers (context)))))) | |
Custom loggers | |
Get string name from symbol or ns | (defn logger-name
^String [a-namespace]
(if (instance? clojure.lang.Namespace a-namespace)
(name (ns-name a-namespace))
(name a-namespace))) |
Get the logger that will be used for the namespace named by | (defn effective-ns-logger
^LoggerConfig [a-namespace]
(let [^Logger logger (log.impl/get-logger log/*logger-factory* a-namespace)]
(.get logger))) |
Find any logger with a specified layout. | (defn- find-logger-layout
[^LoggerConfig logger]
(when logger
(or (first (keep #(.getLayout ^AbstractAppender (val %)) (.getAppenders logger)))
(recur (.getParent logger))))) |
(defprotocol MakeAppender (make-appender ^AbstractAppender [out ns-name layout])) | |
(extend-protocol MakeAppender
java.io.File
(make-appender [^java.io.File out ns-name layout]
(.build
(doto (FileAppender/newBuilder)
(.setName (str ns-name "-file"))
(.setLayout layout)
(.withFileName (.getPath out)))))
java.io.OutputStream
(make-appender [^java.io.OutputStream out ns-name layout]
(.build
(doto (OutputStreamAppender/newBuilder)
(.setName (str ns-name "-os"))
(.setLayout layout)
(.setTarget out))))) | |
Create separate logger for a given namespace to fork out some logs. | (defn for-ns
^AutoCloseable [ns out & [{:keys [additive level]
:or {additive true
level Level/INFO}}]]
(let [config (configuration)
parent-logger (effective-ns-logger ns)
appender (make-appender out (logger-name ns) (find-logger-layout parent-logger))
logger (LoggerConfig. (logger-name ns) level additive)]
(.start appender)
(.addAppender config appender)
(.addAppender logger appender (.getLevel logger) nil)
(.addLogger config (.getName logger) logger)
(.updateLoggers (context))
(reify AutoCloseable
(close [_]
(let [^AbstractConfiguration config (configuration)]
(.removeLogger config (.getName logger))
(.stop appender)
;; this method is only present in AbstractConfiguration
(.removeAppender config (.getName appender))
(.updateLoggers (context))))))) |
JavaScript-friendly interface to metabase.mbql util functions. | (ns metabase.mbql.js (:require [metabase.mbql.normalize :as mbql.normalize] [metabase.util :as u])) |
Sometimes JS queries are passed in with a | (defn- unwrap
[x]
(cond
;; (object? x) only matches for things that are plain objects. eg. `(object? (js/Date.))` is false.
;; This matches anything that descends from `Object`, like `Join` clause, and has a `.raw()` method.
(and x
(instance? js/Object x)
(fn? (.-raw x))) (-> x (.raw) js->clj unwrap)
(map? x) (update-vals x unwrap)
(sequential? x) (mapv unwrap x)
:else x)) |
Normalize an MBQL query, and convert it to the latest and greatest version of MBQL. Returns the CLJS form of the normalized query. Use [[normalize]] for the JS form. | (defn normalize-cljs [query] (-> query js->clj unwrap mbql.normalize/normalize)) |
Normalize an MBQL query, and convert it to the latest and greatest version of MBQL. Returns the JS form of the normalized query. Use [[normalize-cljs]] for the CLJS form. | (defn ^:export normalize [query] (-> query normalize-cljs (clj->js :keyword-fn u/qualified-name))) |
Logic for taking any sort of weird MBQL query and normalizing it into a standardized, canonical form. You can think of this like taking any 'valid' MBQL query and rewriting it as-if it was written in perfect up-to-date MBQL in the latest version. There are four main things done here, done as four separate steps: NORMALIZING TOKENSConverting all identifiers to lower-case, lisp-case keywords. e.g. CANONICALIZING THE QUERYRewriting deprecated MBQL 95/98 syntax and other things that are still supported for backwards-compatibility in
canonical modern MBQL syntax. For example WHOLE-QUERY TRANSFORMATIONSTransformations and cleanup of the query structure as a whole to fix inconsistencies. Whereas the canonicalization
phase operates on a lower-level, transforming invidual clauses, this phase focuses on transformations that affect
multiple clauses, such as removing duplicate references to Fields if they are specified in both the This is not the only place that does such transformations; several pieces of QP middleware perform similar
individual transformations, such as REMOVING EMPTY CLAUSESRemoving empty clauses like Token normalization occurs first, followed by canonicalization, followed by removing empty clauses. | (ns metabase.mbql.normalize (:require [clojure.set :as set] [clojure.walk :as walk] [medley.core :as m] [metabase.mbql.util :as mbql.u] [metabase.mbql.util.match :as mbql.match] [metabase.shared.util.i18n :as i18n] [metabase.util.log :as log] [metabase.util.malli :as mu])) |
True if | (defn- mbql-clause?
[x]
(and (sequential? x)
(not (map-entry? x))
((some-fn keyword? string?) (first x)))) |
Normalize token | (defn- maybe-normalize-token
[x]
(if ((some-fn keyword? string?) x)
(mbql.u/normalize-token x)
x)) |
If (is-clause? :count [:count 10]) ; -> true (is-clause? #{:+ :- :* :/} [:+ 10 20]) ; -> true (This is different from the implementation in | (defn is-clause?
[k-or-ks x]
(and
(mbql-clause? x)
(let [clause-name (maybe-normalize-token (first x))]
(if (coll? k-or-ks)
((set k-or-ks) clause-name)
(= k-or-ks clause-name))))) |
+----------------------------------------------------------------------------------------------------------------+ | NORMALIZE TOKENS | +----------------------------------------------------------------------------------------------------------------+ | |
(declare normalize-tokens) | |
(defmulti ^:private normalize-mbql-clause-tokens (comp maybe-normalize-token first)) | |
(defmethod normalize-mbql-clause-tokens :aggregation
;; nil options should be removed from aggregation references (`[:aggregation 0]`).
[[_ aggregation-index option]]
(cond-> [:aggregation aggregation-index]
(some? option) (conj option))) | |
(defmethod normalize-mbql-clause-tokens :expression
;; For expression references (`[:expression \"my_expression\"]`) keep the arg as is but make sure it is a string.
[[_ expression-name]]
[:expression (if (keyword? expression-name)
(mbql.u/qualified-name expression-name)
expression-name)]) | |
(defmethod normalize-mbql-clause-tokens :binning-strategy
;; For `:binning-strategy` clauses (which wrap other Field clauses) normalize the strategy-name and recursively
;; normalize the Field it bins.
[[_ field strategy-name strategy-param]]
(if strategy-param
(conj (normalize-mbql-clause-tokens [:binning-strategy field strategy-name]) strategy-param)
[:binning-strategy (normalize-tokens field :ignore-path) (maybe-normalize-token strategy-name)])) | |
(defmethod normalize-mbql-clause-tokens :field
[[_ id-or-name opts]]
(let [opts (normalize-tokens opts :ignore-path)]
[:field
id-or-name
(cond-> opts
(:base-type opts) (update :base-type keyword)
(:temporal-unit opts) (update :temporal-unit keyword)
(:binning opts) (update :binning (fn [binning]
(cond-> binning
(:strategy binning) (update :strategy keyword)))))])) | |
(defmethod normalize-mbql-clause-tokens :field-literal
;; Similarly, for Field literals, keep the arg as-is, but make sure it is a string."
[[_ field-name field-type]]
[:field-literal
(if (keyword? field-name)
(mbql.u/qualified-name field-name)
field-name)
(keyword field-type)]) | |
(defmethod normalize-mbql-clause-tokens :datetime-field
;; Datetime fields look like `[:datetime-field <field> <unit>]` or `[:datetime-field <field> :as <unit>]`
;; normalize the unit, and `:as` (if present) tokens, and the Field."
[[_ field as-or-unit maybe-unit]]
(if maybe-unit
[:datetime-field (normalize-tokens field :ignore-path) :as (maybe-normalize-token maybe-unit)]
[:datetime-field (normalize-tokens field :ignore-path) (maybe-normalize-token as-or-unit)])) | |
(defmethod normalize-mbql-clause-tokens :time-interval
;; `time-interval`'s `unit` should get normalized, and `amount` if it's not an integer."
[[_ field amount unit options]]
(if options
(conj (normalize-mbql-clause-tokens [:time-interval field amount unit])
(normalize-tokens options :ignore-path))
[:time-interval
(normalize-tokens field :ignore-path)
(if (integer? amount)
amount
(maybe-normalize-token amount))
(maybe-normalize-token unit)])) | |
(defmethod normalize-mbql-clause-tokens :relative-datetime
;; Normalize a `relative-datetime` clause. `relative-datetime` comes in two flavors:
;;
;; [:relative-datetime :current]
;; [:relative-datetime -10 :day] ; amount & unit"
[[_ amount unit]]
(if unit
[:relative-datetime amount (maybe-normalize-token unit)]
[:relative-datetime :current])) | |
(defmethod normalize-mbql-clause-tokens :interval [[_ amount unit]] [:interval amount (maybe-normalize-token unit)]) | |
(defmethod normalize-mbql-clause-tokens :datetime-add [[_ field amount unit]] [:datetime-add (normalize-tokens field :ignore-path) amount (maybe-normalize-token unit)]) | |
(defmethod normalize-mbql-clause-tokens :datetime-subtract [[_ field amount unit]] [:datetime-subtract (normalize-tokens field :ignore-path) amount (maybe-normalize-token unit)]) | |
(defmethod normalize-mbql-clause-tokens :get-week
[[_ field mode]]
(if mode
[:get-week (normalize-tokens field :ignore-path) (maybe-normalize-token mode)]
[:get-week (normalize-tokens field :ignore-path)])) | |
(defmethod normalize-mbql-clause-tokens :temporal-extract
[[_ field unit mode]]
(if mode
[:temporal-extract (normalize-tokens field :ignore-path) (maybe-normalize-token unit) (maybe-normalize-token mode)]
[:temporal-extract (normalize-tokens field :ignore-path) (maybe-normalize-token unit)])) | |
(defmethod normalize-mbql-clause-tokens :datetime-diff [[_ x y unit]] [:datetime-diff (normalize-tokens x :ignore-path) (normalize-tokens y :ignore-path) (maybe-normalize-token unit)]) | |
(defmethod normalize-mbql-clause-tokens :value ;; The args of a `value` clause shouldn't be normalized. ;; See https://github.com/metabase/metabase/issues/23354 for details [[_ value info]] [:value value info]) | |
(defmethod normalize-mbql-clause-tokens :default ;; MBQL clauses by default are recursively normalized. ;; This includes the clause name (e.g. `[\"COUNT\" ...]` becomes `[:count ...]`) and args. [[clause-name & args]] (into [(maybe-normalize-token clause-name)] (map #(normalize-tokens % :ignore-path)) args)) | |
(defn- aggregation-subclause?
[x]
(or (when ((some-fn keyword? string?) x)
(#{:avg :count :cum-count :distinct :stddev :sum :min :max :+ :- :/ :*
:sum-where :count-where :share :var :median :percentile}
(maybe-normalize-token x)))
(when (mbql-clause? x)
(aggregation-subclause? (first x))))) | |
For old-style aggregations like | (defn- normalize-ag-clause-tokens
[ag-clause]
(cond
;; something like {:aggregations :count}
((some-fn keyword? string?) ag-clause)
(maybe-normalize-token ag-clause)
;; named aggregation ([:named <ag> <name>])
(is-clause? :named ag-clause)
(let [[_ wrapped-ag & more] ag-clause]
(into [:named (normalize-ag-clause-tokens wrapped-ag)] more))
;; something wack like {:aggregations [:count [:sum 10]]} or {:aggregations [:count :count]}
(when (mbql-clause? ag-clause)
(aggregation-subclause? (second ag-clause)))
(mapv normalize-ag-clause-tokens ag-clause)
:else
(normalize-tokens ag-clause :ignore-path))) |
For expressions, we don't want to normalize the name of the expression; keep that as is, and make it a string; normalize the definitions as normal. | (defn- normalize-expressions-tokens
[expressions-clause]
(into {} (for [[expression-name definition] expressions-clause]
[(mbql.u/qualified-name expression-name)
(normalize-tokens definition :ignore-path)]))) |
Normalize tokens in the order-by clause, which can have different syntax when using MBQL 95 or 98
rules ( | (defn- normalize-order-by-tokens
[clauses]
(vec (for [subclause clauses]
(if (mbql-clause? subclause)
;; MBQL 98+ [direction field] style: normalize as normal
(normalize-mbql-clause-tokens subclause)
;; otherwise it's MBQL 95 [field direction] style: flip the args and *then* normalize the clause. And then
;; flip it back to put it back the way we found it.
(reverse (normalize-mbql-clause-tokens (reverse subclause))))))) |
Get the function that should be used to transform values for normalized key | (defn- template-tag-definition-key->transform-fn
[k]
(get {:default identity
:type maybe-normalize-token
:widget-type maybe-normalize-token}
k
;; if there's not a special transform function for the key in the map above, just wrap the key-value
;; pair in a dummy map and let [[normalize-tokens]] take care of it. Then unwrap
(fn [v]
(-> (normalize-tokens {k v} :ignore-path)
(get k))))) |
For a template tag definition, normalize all the keys appropriately. | (defn- normalize-template-tag-definition
[tag-definition]
(let [tag-def (into
{}
(map (fn [[k v]]
(let [k (maybe-normalize-token k)
transform-fn (template-tag-definition-key->transform-fn k)]
[k (transform-fn v)])))
tag-definition)]
;; `:widget-type` is a required key for Field Filter (dimension) template tags -- see
;; [[metabase.mbql.schema/TemplateTag:FieldFilter]] -- but prior to v42 it wasn't usually included by the
;; frontend. See #20643. If it's not present, just add in `:category` which will make things work they way they
;; did in the past.
(cond-> tag-def
(and (= (:type tag-def) :dimension)
(not (:widget-type tag-def)))
(assoc :widget-type :category)))) |
Normalize native-query template tags. Like | (defn- normalize-template-tags
[template-tags]
(into
{}
(map (fn [[tag-name tag-definition]]
(let [tag-name (mbql.u/qualified-name tag-name)]
[tag-name
(-> (normalize-template-tag-definition tag-definition)
(assoc :name tag-name))])))
template-tags)) |
Normalize a parameter in the query | (defn normalize-query-parameter
[{:keys [type target id values_source_config], :as param}]
(cond-> param
id (update :id mbql.u/qualified-name)
;; some things that get ran thru here, like dashcard param targets, do not have :type
type (update :type maybe-normalize-token)
target (update :target #(normalize-tokens % :ignore-path))
values_source_config (update-in [:values_source_config :label_field] #(normalize-tokens % :ignore-path))
values_source_config (update-in [:values_source_config :value_field] #(normalize-tokens % :ignore-path)))) |
(defn- normalize-source-query [source-query]
(let [{native? :native, :as source-query} (m/map-keys maybe-normalize-token source-query)]
(if native?
(-> source-query
(set/rename-keys {:native :query})
(normalize-tokens [:native])
(set/rename-keys {:query :native}))
(normalize-tokens source-query [:query])))) | |
(defn- normalize-join [join]
;; path in call to `normalize-tokens` is [:query] so it will normalize `:source-query` as appropriate
(let [{:keys [strategy fields alias], :as join} (normalize-tokens join :query)]
(cond-> join
strategy
(update :strategy maybe-normalize-token)
((some-fn keyword? string?) fields)
(update :fields maybe-normalize-token)
alias
(update :alias mbql.u/qualified-name)))) | |
(declare canonicalize-mbql-clauses) | |
Normalize the field ref. Ensure it's well-formed mbql, not just json. | (defn normalize-field-ref [clause] (-> clause normalize-tokens canonicalize-mbql-clauses)) |
Normalize source/results metadata for a single column. | (defn normalize-source-metadata
[metadata]
{:pre [(map? metadata)]}
(-> (reduce #(m/update-existing %1 %2 keyword) metadata [:base_type :effective_type :semantic_type :visibility_type :source :unit])
(m/update-existing :field_ref normalize-field-ref)
(m/update-existing :fingerprint walk/keywordize-keys))) |
For native queries, normalize the top-level keys, and template tags, but nothing else. | (defn- normalize-native-query
[native-query]
(let [native-query (m/map-keys maybe-normalize-token native-query)]
(cond-> native-query
(seq (:template-tags native-query)) (update :template-tags normalize-template-tags)))) |
Map of special functions that should be used to perform token normalization for a given path. For example, the
TODO - why not make this a multimethod of some sort? | (def ^:private path->special-token-normalization-fn
{:type maybe-normalize-token
;; don't normalize native queries
:native normalize-native-query
:query {:aggregation normalize-ag-clause-tokens
:expressions normalize-expressions-tokens
:order-by normalize-order-by-tokens
:source-query normalize-source-query
:source-metadata {::sequence normalize-source-metadata}
:joins {::sequence normalize-join}}
;; we smuggle metadata for datasets and want to preserve their "database" form vs a normalized form so it matches
;; the style in annotate.clj
:info {:metadata/dataset-metadata identity}
:parameters {::sequence normalize-query-parameter}
:context #(some-> % maybe-normalize-token)
:source-metadata {::sequence normalize-source-metadata}
:viz-settings maybe-normalize-token}) |
Recursively normalize tokens in Every time this function recurses (thru a map value) it adds a new (normalized) key to key path, e.g. In some cases, dealing with the path isn't desirable, but we don't want to accidentally trigger normalization
functions (such as accidentally normalizing the | (defn normalize-tokens
[x & [path]]
(let [path (if (keyword? path)
[path]
(vec path))
special-fn (when (seq path)
(get-in path->special-token-normalization-fn path))]
(try
(cond
(fn? special-fn)
(special-fn x)
;; Skip record types because this query is an `expanded` query, which is not going to play nice here. Hopefully we
;; can remove expanded queries entirely soon.
(record? x)
x
;; maps should just get the keys normalized and then recursively call normalize-tokens on the values.
;; Each recursive call appends to the keypath above so we can handle top-level clauses in a special way if needed
(map? x)
(into {} (for [[k v] x
:let [k (maybe-normalize-token k)]]
[k (normalize-tokens v (conj (vec path) k))]))
;; MBQL clauses handled above because of special cases
(mbql-clause? x)
(normalize-mbql-clause-tokens x)
;; for non-mbql sequential collections (probably something like the subclauses of :order-by or something like
;; that) recurse on all the args.
;;
;; To signify that we're recursing into a sequential collection, this appends `::sequence` to path
(sequential? x)
(mapv #(normalize-tokens % (conj (vec path) ::sequence)) x)
:else
x)
(catch #?(:clj Throwable :cljs js/Error) e
(throw (ex-info (i18n/tru "Error normalizing form: {0}" (ex-message e))
{:form x, :path path, :special-fn special-fn}
e)))))) |
+----------------------------------------------------------------------------------------------------------------+ | CANONICALIZE | +----------------------------------------------------------------------------------------------------------------+ | |
Wrap raw integer Field IDs (i.e., those in an implicit 'field' position) in a {:filter [:= 10 20]} ; -> {:filter [:= [:field 10 nil] 20]} | (defn- wrap-implicit-field-id
[field]
(if (integer? field)
[:field field nil]
field)) |
(defmulti ^:private canonicalize-mbql-clause
{:arglists '([clause])}
(fn [clause]
(when (mbql-clause? clause)
(first clause)))) | |
(defmethod canonicalize-mbql-clause :default [clause] clause) | |
If | (defn- canonicalize-implicit-field-id [clause] (canonicalize-mbql-clause (wrap-implicit-field-id clause))) |
(defmethod canonicalize-mbql-clause :field
[[_ id-or-name opts]]
(if (is-clause? :field id-or-name)
(let [[_ nested-id-or-name nested-opts] id-or-name]
(canonicalize-mbql-clause [:field nested-id-or-name (not-empty (merge nested-opts opts))]))
;; remove empty stuff from the options map. The `remove-empty-clauses` step will further remove empty stuff
;; afterwards
[:field id-or-name (not-empty opts)])) | |
(defmethod canonicalize-mbql-clause :aggregation
[[_tag index opts]]
(if (empty? opts)
[:aggregation index]
[:aggregation index opts])) | |
legacy Field clauses | |
(defmethod canonicalize-mbql-clause :field-id
[[_ id]]
;; if someone is dumb and does something like [:field-id [:field-literal ...]] be nice and fix it for them.
(if (mbql-clause? id)
(canonicalize-mbql-clause id)
[:field id nil])) | |
(defmethod canonicalize-mbql-clause :field-literal
[[_ field-name base-type]]
[:field field-name {:base-type base-type}]) | |
(defmethod canonicalize-mbql-clause :fk->
[[_ field-1 field-2]]
(let [[_ source _] (canonicalize-implicit-field-id field-1)
[_ dest dest-opts] (canonicalize-implicit-field-id field-2)]
[:field dest (assoc dest-opts :source-field source)])) | |
(defmethod canonicalize-mbql-clause :joined-field
[[_ join-alias field]]
(-> (canonicalize-implicit-field-id field)
(mbql.u/assoc-field-options :join-alias join-alias))) | |
(defmethod canonicalize-mbql-clause :datetime-field
[clause]
(case (count clause)
3
(let [[_ field unit] clause]
(-> (canonicalize-implicit-field-id field)
(mbql.u/with-temporal-unit unit)))
4
(let [[_ field _ unit] clause]
(canonicalize-mbql-clause [:datetime-field field unit])))) | |
(defmethod canonicalize-mbql-clause :binning-strategy
[[_ field strategy param binning-options]]
(let [[_ id-or-name opts] (canonicalize-implicit-field-id field)]
[:field
id-or-name
(assoc opts :binning (merge {:strategy strategy}
(when param
{strategy param})
binning-options))])) | |
filter clauses | |
For | (defn- canonicalize-compound-filter-clause [[filter-name & args]]
(mbql.u/simplify-compound-filter
(into [filter-name]
;; we need to canonicalize any other mbql clauses that might show up in args here because
;; simplify-compund-filter validates its output :(
(map canonicalize-mbql-clause args)))) |
(doseq [clause-name [:and :or :not]]
(defmethod canonicalize-mbql-clause clause-name
[clause]
(canonicalize-compound-filter-clause clause))) | |
(defmethod canonicalize-mbql-clause :inside
[[_ field-1 field-2 & coordinates]]
(into [:inside
(canonicalize-implicit-field-id field-1)
(canonicalize-implicit-field-id field-2)]
coordinates)) | |
(defmethod canonicalize-mbql-clause :time-interval
[[_ field & args]]
;; if you specify a `:temporal-unit` for the Field inside a `:time-interval`, remove it. The unit in
;; `:time-interval` takes precedence.
(let [field (cond-> (canonicalize-implicit-field-id field)
(mbql.u/is-clause? :field field) (mbql.u/update-field-options dissoc :temporal-unit))]
(into [:time-interval field] args))) | |
all the other filter types have an implict field ID for the first arg (e.g. [:= 10 20] gets canonicalized to [:= [:field-id 10] 20] | (defn- canonicalize-simple-filter-clause
[[filter-name first-arg & other-args]]
;; Support legacy expressions like [:> 1 25] where 1 is a field id.
(into [filter-name (canonicalize-implicit-field-id first-arg)]
(map canonicalize-mbql-clause other-args))) |
(doseq [clause-name [:starts-with :ends-with :contains :does-not-contain
:= :!= :< :<= :> :>=
:is-empty :not-empty :is-null :not-null
:between]]
(defmethod canonicalize-mbql-clause clause-name
[clause]
(canonicalize-simple-filter-clause clause))) | |
aggregations/expression subclauses | |
Remove | (defmethod canonicalize-mbql-clause :rows [_] nil) |
TODO -- if options is empty, should we just unwrap the clause? | (defmethod canonicalize-mbql-clause :aggregation-options [[_ wrapped-aggregation-clause options]] [:aggregation-options (canonicalize-mbql-clause wrapped-aggregation-clause) options]) |
for legacy 99.99% of clauses should have no options, however if they do and | (defmethod canonicalize-mbql-clause :named
[[_ wrapped-ag expr-name & more]]
(canonicalize-mbql-clause
[:aggregation-options
(canonicalize-mbql-clause wrapped-ag)
(let [[{:keys [use-as-display-name?]}] more]
(if (false? use-as-display-name?)
{:name expr-name}
{:display-name expr-name}))])) |
(defn- canonicalize-count-clause [[clause-name field]]
(if field
[clause-name (canonicalize-implicit-field-id field)]
[clause-name])) | |
(doseq [clause-name [:count :cum-count]]
(defmethod canonicalize-mbql-clause clause-name
[clause]
(canonicalize-count-clause clause))) | |
(defn- canonicalize-simple-aggregation-with-field [[clause-name field]] [clause-name (canonicalize-implicit-field-id field)]) | |
(doseq [clause-name [:avg :cum-sum :distinct :stddev :sum :min :max :median :var]]
(defmethod canonicalize-mbql-clause clause-name
[clause]
(canonicalize-simple-aggregation-with-field clause))) | |
(defmethod canonicalize-mbql-clause :percentile [[_ field percentile]] [:percentile (canonicalize-implicit-field-id field) percentile]) | |
(defn- canonicalize-filtered-aggregation-clause [[clause-name filter-subclause]] [clause-name (canonicalize-mbql-clause filter-subclause)]) | |
(doseq [clause-name [:share :count-where]]
(defmethod canonicalize-mbql-clause clause-name
[clause]
(canonicalize-filtered-aggregation-clause clause))) | |
(defmethod canonicalize-mbql-clause :sum-where [[_ field filter-subclause]] [:sum-where (canonicalize-mbql-clause field) (canonicalize-mbql-clause filter-subclause)]) | |
(defmethod canonicalize-mbql-clause :case
[[_ clauses options]]
(if options
(conj (canonicalize-mbql-clause [:case clauses])
(normalize-tokens options :ignore-path))
[:case (vec (for [[pred expr] clauses]
[(canonicalize-mbql-clause pred) (canonicalize-mbql-clause expr)]))])) | |
(defmethod canonicalize-mbql-clause :substring
[[_ arg start & more]]
(into [:substring
(canonicalize-mbql-clause arg)
;; 0 indexes were allowed in the past but we are now enforcing this rule in MBQL.
;; This allows stored queries with literal 0 in the index to work.
(if (= 0 start) 1 (canonicalize-mbql-clause start))]
(map canonicalize-mbql-clause more))) | |
top-level key canonicalization | |
Walk an | (defn- canonicalize-mbql-clauses
[form]
(cond
;; Special handling for records so that they are not converted into plain maps.
;; Only the values are canonicalized.
(record? form)
(reduce-kv (fn [r k x] (assoc r k (canonicalize-mbql-clauses x))) form form)
;; Only the values are canonicalized.
(map? form)
(update-vals form canonicalize-mbql-clauses)
(mbql-clause? form)
(let [top-canonical
(try
(canonicalize-mbql-clause form)
(catch #?(:clj Throwable :cljs js/Error) e
(log/error (i18n/tru "Invalid clause:") form)
(throw (ex-info (i18n/tru "Invalid MBQL clause: {0}" (ex-message e))
{:clause form}
e))))]
;; Canonical clauses are assumed to be sequential things conj'd at the end.
;; In fact, they should better be vectors.
(if (seq top-canonical)
(into (conj (empty top-canonical) (first top-canonical))
(map canonicalize-mbql-clauses)
(rest top-canonical))
top-canonical))
;; ISeq instances (e.g., list and lazy sequences) are converted to vectors.
(seq? form)
(mapv canonicalize-mbql-clauses form)
;; Other collections (e.g., vectors, sets, and queues) are assumed to be conj'd at the end
;; and we keep their types.
(coll? form)
(into (empty form) (map canonicalize-mbql-clauses) form)
:else
form)) |
Convert old MBQL 95 single-aggregations like | (defn- wrap-single-aggregations
[aggregations]
(mbql.match/replace aggregations
seq? (recur (vec &match))
;; something like {:aggregations :count} -- MBQL 95 single aggregation
keyword?
[[&match]]
;; special-case: MBQL 98 multiple aggregations using unwrapped :count or :rows
;; e.g. {:aggregations [:count [:sum 10]]} or {:aggregations [:count :count]}
[(_ :guard (every-pred keyword? (complement #{:named :+ :- :* :/})))
(_ :guard aggregation-subclause?)
& _]
(into [] (mapcat wrap-single-aggregations) aggregations)
;; something like {:aggregations [:sum 10]} -- MBQL 95 single aggregation
[(_ :guard keyword?) & _]
[&match]
_
&match)) |
Canonicalize subclauses (see above) and make sure | (defn- canonicalize-aggregations
[aggregations]
(->> (wrap-single-aggregations aggregations)
(keep canonicalize-mbql-clauses)
vec)) |
(defn- canonicalize-breakouts [breakouts]
(if (mbql-clause? breakouts)
(recur [breakouts])
(not-empty (mapv wrap-implicit-field-id breakouts)))) | |
Make sure order by clauses like | (defn- canonicalize-order-by
[clauses]
(mbql.match/replace clauses
seq? (recur (vec &match))
;; MBQL 95 reversed [<field> <direction>] clause
[field :asc] (recur [:asc field])
[field :desc] (recur [:desc field])
[field :ascending] (recur [:asc field])
[field :descending] (recur [:desc field])
;; MBQL 95 names but MBQL 98+ reversed syntax
[:ascending field] (recur [:asc field])
[:descending field] (recur [:desc field])
[:asc field] [:asc (canonicalize-implicit-field-id field)]
[:desc field] [:desc (canonicalize-implicit-field-id field)]
;; this case should be the first one hit when we come in with a vector of clauses e.g. [[:asc 1] [:desc 2]]
[& clauses] (vec (distinct (map canonicalize-order-by clauses))))) |
(declare canonicalize-inner-mbql-query) | |
(defn- canonicalize-template-tag [{:keys [dimension], :as tag}]
(cond-> tag
dimension (update :dimension canonicalize-mbql-clause))) | |
(defn- canonicalize-template-tags [tags]
(into {} (for [[tag-name tag] tags]
[tag-name (canonicalize-template-tag tag)]))) | |
(defn- canonicalize-native-query [{:keys [template-tags], :as native-query}]
(cond-> native-query
template-tags (update :template-tags canonicalize-template-tags))) | |
(defn- canonicalize-source-query [{native? :native, :as source-query}]
(cond-> source-query
(not native?) canonicalize-inner-mbql-query
native? canonicalize-native-query)) | |
(defn- non-empty? [x]
(if (coll? x)
(seq x)
(some? x))) | |
Perform specific steps to canonicalize the various top-level clauses in an MBQL query. | (defn- canonicalize-top-level-mbql-clauses
[mbql-query]
(cond-> mbql-query
(non-empty? (:aggregation mbql-query)) (update :aggregation canonicalize-aggregations)
(non-empty? (:breakout mbql-query)) (update :breakout canonicalize-breakouts)
(non-empty? (:fields mbql-query)) (update :fields (partial mapv wrap-implicit-field-id))
(non-empty? (:order-by mbql-query)) (update :order-by canonicalize-order-by)
(non-empty? (:source-query mbql-query)) (update :source-query canonicalize-source-query))) |
(def ^:private ^{:arglists '([query])} canonicalize-inner-mbql-query
(comp canonicalize-mbql-clauses canonicalize-top-level-mbql-clauses)) | |
In Metabase 0.33.0 | (defn- move-source-metadata-to-mbql-query
[{:keys [source-metadata], :as query}]
(-> query
(dissoc :source-metadata)
(assoc-in [:query :source-metadata] source-metadata))) |
(defn- canonicalize-mbql-clauses-excluding-native
[{:keys [native] :as outer-query}]
(if native
(-> outer-query (dissoc :native) canonicalize-mbql-clauses (assoc :native native))
(canonicalize-mbql-clauses outer-query))) | |
Canonicalize a query [MBQL query], rewriting the query as if you perfectly followed the recommended style guides for writing MBQL. Does things like removes unneeded and empty clauses, converts older MBQL '95 syntax to MBQL '98, etc. | (defn- canonicalize
[{:keys [query parameters source-metadata native], :as outer-query}]
(try
(cond-> outer-query
source-metadata move-source-metadata-to-mbql-query
query (update :query canonicalize-inner-mbql-query)
parameters (update :parameters (partial mapv canonicalize-mbql-clauses))
native (update :native canonicalize-native-query)
true canonicalize-mbql-clauses-excluding-native)
(catch #?(:clj Throwable :cljs js/Error) e
(throw (ex-info (i18n/tru "Error canonicalizing query: {0}" (ex-message e))
{:query query}
e))))) |
+----------------------------------------------------------------------------------------------------------------+ | WHOLE-QUERY TRANSFORMATIONS | +----------------------------------------------------------------------------------------------------------------+ | |
Remove any Fields specified in both We will remove either exact matches: {:breakout [[:field-id 10]], :fields [[:field-id 10]]} ; -> {:breakout [[:field-id 10]]} or unbucketed matches: {:breakout [[:datetime-field [:field-id 10] :month]], :fields [[:field-id 10]]} ;; -> {:breakout [[:field-id 10]]} | (defn- remove-breakout-fields-from-fields
[{{:keys [breakout fields]} :query, :as query}]
(if-not (and (seq breakout) (seq fields))
query
;; get a set of all Field clauses (of any type) in the breakout. For temporal-bucketed fields, we'll include both
;; the bucketed `[:datetime-field <field> ...]` clause and the `<field>` clause it wraps
(let [breakout-fields (into #{} cat (mbql.match/match breakout
[:field id-or-name opts]
[&match
[:field id-or-name (dissoc opts :temporal-unit)]]))]
;; now remove all the Fields in `:fields` that match the ones in the set
(update-in query [:query :fields] (comp vec (partial remove breakout-fields)))))) |
Perform transformations that operate on the query as a whole, making sure the structure as a whole is logical and consistent. | (defn- perform-whole-query-transformations
[query]
(try
(remove-breakout-fields-from-fields query)
(catch #?(:clj Throwable :cljs js/Error) e
(throw (ex-info (i18n/tru "Error performing whole query transformations")
{:query query}
e))))) |
+----------------------------------------------------------------------------------------------------------------+ | REMOVING EMPTY CLAUSES | +----------------------------------------------------------------------------------------------------------------+ | |
(declare remove-empty-clauses) | |
(defn- remove-empty-clauses-in-map [m path]
(let [m (into (empty m) (for [[k v] m
:let [v (remove-empty-clauses v (conj path k))]
:when (some? v)]
[k v]))]
(when (seq m)
m))) | |
(defn- remove-empty-clauses-in-sequence [xs path]
(let [xs (mapv #(remove-empty-clauses % (conj path ::sequence))
xs)]
(when (some some? xs)
xs))) | |
(defn- remove-empty-clauses-in-join [join] (remove-empty-clauses join [:query])) | |
(defn- remove-empty-clauses-in-source-query [{native? :native, :as source-query}]
(if native?
(-> source-query
(set/rename-keys {:native :query})
(remove-empty-clauses [:native])
(set/rename-keys {:query :native}))
(remove-empty-clauses source-query [:query]))) | |
(def ^:private path->special-remove-empty-clauses-fn
{:native identity
:query {:source-query remove-empty-clauses-in-source-query
:joins {::sequence remove-empty-clauses-in-join}}
:viz-settings identity}) | |
Remove any empty or | (defn- remove-empty-clauses
([query]
(remove-empty-clauses query []))
([x path]
(try
(let [special-fn (when (seq path)
(get-in path->special-remove-empty-clauses-fn path))]
(cond
(fn? special-fn) (special-fn x)
(record? x) x
(map? x) (remove-empty-clauses-in-map x path)
(sequential? x) (remove-empty-clauses-in-sequence x path)
:else x))
(catch #?(:clj Throwable :cljs js/Error) e
(throw (ex-info "Error removing empty clauses from form."
{:form x, :path path}
e)))))) |
+----------------------------------------------------------------------------------------------------------------+ | PUTTING IT ALL TOGETHER | +----------------------------------------------------------------------------------------------------------------+ | |
Normalize the tokens in a Metabase query (i.e., make them all | (def ^{:arglists '([outer-query])} normalize
(let [normalize* (comp remove-empty-clauses
perform-whole-query-transformations
canonicalize
normalize-tokens)]
(fn [query]
(try
(normalize* query)
(catch #?(:clj Throwable :cljs js/Error) e
(throw (ex-info (i18n/tru "Error normalizing query: {0}" (ex-message e))
{:query query}
e))))))) |
Normalize just a specific fragment of a query, such as just the inner MBQL part or just a filter clause. (normalize-fragment [:query :filter] ["=" 100 200]) ;;-> [:= [:field-id 100] 200] | (mu/defn normalize-fragment
[path :- [:maybe [:sequential :keyword]]
x]
(if-not (seq path)
(normalize x)
(get (normalize-fragment (butlast path) {(last path) x}) (last path)))) |
Predicate functions for checking whether something is a valid instance of a given MBQL clause. | (ns metabase.mbql.predicates
(:require
[metabase.lib.schema.temporal-bucketing
:as lib.schema.temporal-bucketing]
[metabase.mbql.schema :as mbql.s]
[metabase.util.malli.registry :as mr])) |
Is | (def ^{:arglists '([unit])} DateTimeUnit?
(mr/validator ::lib.schema.temporal-bucketing/unit)) |
Is this a valid Aggregation clause? | (def ^{:arglists '([ag-clause])} Aggregation?
(mr/validator mbql.s/Aggregation)) |
Is this a valid Field clause? | (def ^{:arglists '([field-clause])} Field?
(mr/validator mbql.s/Field)) |
Is this a valid | (def ^{:arglists '([filter-clause])} Filter?
(mr/validator mbql.s/Filter)) |
Is this a valid DatetimeExpression clause? | (def ^{:arglists '([filter-clause])} DatetimeExpression?
(mr/validator mbql.s/DatetimeExpression)) |
Is this a something that is valid as a top-level expression definition? | (def ^{:arglists '([field-clause])} FieldOrExpressionDef?
(mr/validator mbql.s/FieldOrExpressionDef)) |
Schema for validating a normalized MBQL query. This is also the definitive grammar for MBQL, wow! | (ns metabase.mbql.schema (:refer-clojure :exclude [count distinct min max + - / * and or not not-empty = < > <= >= time case concat replace abs]) (:require [clojure.core :as core] [clojure.set :as set] [malli.core :as mc] [malli.error :as me] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.expression.temporal :as lib.schema.expression.temporal] [metabase.lib.schema.id :as lib.schema.id] [metabase.lib.schema.literal :as lib.schema.literal] [metabase.mbql.schema.helpers :as helpers :refer [is-clause?]] [metabase.mbql.schema.macros :refer [defclause one-of]] [metabase.shared.util.i18n :as i18n] [metabase.util.malli.registry :as mr])) |
A NOTE ABOUT METADATA: Clauses below are marked with the following tags for documentation purposes:
| |
(def ^:private NonBlankString [:ref ::lib.schema.common/non-blank-string]) | |
(def ^:private BaseType [:ref ::lib.schema.common/base-type]) | |
(def ^:private SemanticOrRelationType [:ref ::lib.schema.common/semantic-or-relation-type]) | |
(def ^:private PositiveInt [:ref ::lib.schema.common/positive-int]) | |
(def ^:private IntGreaterThanOrEqualToZero [:ref ::lib.schema.common/int-greater-than-or-equal-to-zero]) | |
(def ^:private FieldID [:ref ::lib.schema.id/field]) | |
(def ^:private CardID [:ref ::lib.schema.id/card]) | |
(def ^:private TableID [:ref ::lib.schema.id/table]) | |
(def ^:private RawDateLiteral [:ref ::lib.schema.literal/date]) | |
(def ^:private RawDateTimeLiteral [:ref ::lib.schema.literal/datetime]) | |
(def ^:private RawTimeLiteral [:ref ::lib.schema.literal/time]) | |
Set of valid units for bucketing or comparing against a date Field.
| (def ^:private date-bucketing-units
#{:default :day :day-of-week :day-of-month :day-of-year :week :week-of-year
:month :month-of-year :quarter :quarter-of-year :year}) |
Set of valid units for bucketing or comparing against a time Field. | (def ^:private time-bucketing-units
#{:default :millisecond :second :minute :minute-of-hour :hour :hour-of-day}) |
Set of valid units for bucketing or comparing against a datetime Field. | (def datetime-bucketing-units (set/union date-bucketing-units time-bucketing-units)) |
Valid unit for date bucketing. | (def ^:private DateUnit
(into [:enum {:error/message "date bucketing unit"}] date-bucketing-units)) |
Valid unit for time bucketing. it could make sense to say hour-of-day(field) = hour-of-day("2018-10-10T12:00") but it does not make sense to say month-of-year(field) = month-of-year("08:00:00"), does it? So we'll restrict the set of units a TimeValue can have to ones that have no notion of day/date. | (def ^:private TimeUnit
(into [:enum {:error/message "time bucketing unit"}] time-bucketing-units)) |
Valid unit for datetime bucketing. | (def DateTimeUnit
(into [:enum {:error/message "datetime bucketing unit"}] datetime-bucketing-units)) |
Valid timezone id. | (def ^:private TimezoneId [:ref ::lib.schema.expression.temporal/timezone-id]) |
Valid units to extract from a temporal. | (def ^:private TemporalExtractUnit
[:enum
{:error/message "temporal extract unit"}
:year-of-era
:quarter-of-year
:month-of-year
:week-of-year-iso
:week-of-year-us
:week-of-year-instance
:day-of-month
:day-of-week
:hour-of-day
:minute-of-hour
:second-of-minute]) |
Valid units for a datetime-diff clause. | (def ^:private DatetimeDiffUnit
[:enum {:error/message "datetime-diff unit"} :second :minute :hour :day :week :month :quarter :year]) |
Valid modes to extract weeks. | (def ^:private ExtractWeekMode
[:enum {:error/message "temporal-extract week extraction mode"} :iso :us :instance]) |
(def ^:private RelativeDatetimeUnit
[:enum {:error/message "relative-datetime unit"} :default :minute :hour :day :week :month :quarter :year]) | |
TODO - | (defclause relative-datetime n [:or [:= :current] :int] unit (optional RelativeDatetimeUnit)) |
(defclause interval n :int unit RelativeDatetimeUnit) | |
This clause is automatically generated by middleware when datetime literals (literal strings or one of the Java types) are encountered. Unit is inferred by looking at the Field the timestamp is compared against. Implemented mostly to convenience driver implementations. You don't need to use this form directly when writing MBQL; datetime literal strings are preferred instead. example: [:= [:field 10 {:temporal-unit :day}] "2018-10-02"] becomes: [:= [:field 10 {:temporal-unit :day}] [:absolute-datetime #inst "2018-10-02" :day]] | (mr/def ::absolute-datetime
[:multi {:error/message "valid :absolute-datetime clause"
:dispatch (fn [x]
(cond
(core/not (is-clause? :absolute-datetime x)) :invalid
(mr/validate RawDateLiteral (second x)) :date
:else :datetime))}
[:invalid [:fn
{:error/message "not an :absolute-datetime clause"}
(constantly false)]]
[:date (helpers/clause
:absolute-datetime
"date" RawDateLiteral
"unit" DateUnit)]
[:datetime (helpers/clause
:absolute-datetime
"datetime" RawDateTimeLiteral
"unit" DateTimeUnit)]]) |
Schema for an | (def ^:internal ^{:clause-name :absolute-datetime} absolute-datetime
[:ref ::absolute-datetime]) |
almost exactly the same as | (defclause ^:internal time time RawTimeLiteral unit TimeUnit) |
Schema for a valid date or datetime literal. | (def ^:private DateOrDatetimeLiteral
[:or
{:error/message "date or datetime literal"}
absolute-datetime
;; literal datetime strings and Java types will get transformed to [[absolute-datetime]] clauses automatically by
;; middleware so drivers don't need to deal with these directly. You only need to worry about handling
;; `absolute-datetime` clauses.
RawDateTimeLiteral
RawDateLiteral]) |
(mr/def ::TimeLiteral
[:or
{:error/message "time literal"}
time
RawTimeLiteral]) | |
Schema for valid time literals. | (def ^:private TimeLiteral [:ref ::TimeLiteral]) |
(mr/def ::TemporalLiteral
[:or
{:error/message "temporal literal"}
DateOrDatetimeLiteral
TimeLiteral]) | |
Schema for valid temporal literals. | (def ^:private TemporalLiteral [:ref ::TemporalLiteral]) |
(mr/def ::DateTimeValue (one-of absolute-datetime relative-datetime time)) | |
Schema for a datetime value drivers will personally have to handle, either an | (def DateTimeValue [:ref ::DateTimeValue]) |
-------------------------------------------------- Other Values -------------------------------------------------- | |
Type info about a value in a | (def ^:private ValueTypeInfo
[:map
[:database_type {:optional true} [:maybe NonBlankString]]
[:base_type {:optional true} [:maybe BaseType]]
[:semantic_type {:optional true} [:maybe SemanticOrRelationType]]
[:unit {:optional true} [:maybe DateTimeUnit]]
[:name {:optional true} [:maybe NonBlankString]]]) |
Arguments to filter clauses are automatically replaced with [:value | (defclause ^:internal value value :any type-info [:maybe ValueTypeInfo]) |
----------------------------------------------------- Fields ----------------------------------------------------- | |
Expression references refer to a something in the [:+ [:field 1 nil] [:field 2 nil]] As of 0.42.0 | (defclause ^{:requires-features #{:expressions}} expression
expression-name NonBlankString
options (optional :map)) |
Schema for a valid value for the | (def ^:private BinningStrategyName
[:enum {:error/message "binning strategy"} :num-bins :bin-width :default]) |
(defn- validate-bin-width [schema]
[:and
schema
[:fn
{:error/message "You must specify :bin-width when using the :bin-width strategy."}
(fn [{:keys [strategy bin-width]}]
(if (core/= strategy :bin-width)
bin-width
true))]]) | |
(defn- validate-num-bins [schema]
[:and
schema
[:fn
{:error/message "You must specify :num-bins when using the :num-bins strategy."}
(fn [{:keys [strategy num-bins]}]
(if (core/= strategy :num-bins)
num-bins
true))]]) | |
Schema for | (def ^:private FieldBinningOptions
(-> [:map
{:error/message "binning options"}
[:strategy BinningStrategyName]
[:num-bins {:optional true} PositiveInt]
[:bin-width {:optional true} [:and
number?
[:fn
{:error/message "bin width must be >= 0."}
(complement neg?)]]]]
validate-bin-width
validate-num-bins)) |
Whether | (defn valid-temporal-unit-for-base-type?
([{:keys [base-type temporal-unit] :as _field-options}]
(valid-temporal-unit-for-base-type? base-type temporal-unit))
([base-type temporal-unit]
(if-let [units (when (core/and temporal-unit base-type)
(condp #(isa? %2 %1) base-type
:type/Date date-bucketing-units
:type/Time time-bucketing-units
:type/DateTime datetime-bucketing-units
nil))]
(contains? units temporal-unit)
true))) |
(defn- validate-temporal-unit [schema]
;; TODO - consider breaking this out into separate constraints for the three different types so we can generate more
;; specific error messages
[:and
schema
[:fn
{:error/message "Invalid :temporal-unit for the specified :base-type."}
valid-temporal-unit-for-base-type?]]) | |
(defn- no-binning-options-at-top-level [schema]
[:and
schema
[:fn
{:error/message "Found :binning keys at the top level of :field options. binning-related options belong under the :binning key."}
(complement :strategy)]]) | |
(mr/def ::FieldOptions
(-> [:map
{:error/message "field options"}
[:base-type {:optional true} [:maybe BaseType]]
;;
;; replaces `fk->`
;;
;; `:source-field` is used to refer to a FieldOrExpression from a different Table you would like IMPLICITLY JOINED to the
;; source table.
;;
;; If both `:source-field` and `:join-alias` are supplied, `:join-alias` should be used to perform the join;
;; `:source-field` should be for information purposes only.
[:source-field {:optional true} [:maybe FieldID]]
;;
;; `:temporal-unit` is used to specify DATE BUCKETING for a FieldOrExpression that represents a moment in time
;; of some sort.
;;
;; There is no requirement that all `:type/Temporal` derived FieldOrExpressions specify a `:temporal-unit`, but
;; for legacy reasons `:field` clauses that refer to `:type/DateTime` FieldOrExpressions will be
;; automatically "bucketed" in the `:breakout` and `:filter` clauses, but nowhere else. Auto-bucketing only
;; applies to `:filter` clauses when values for comparison are `yyyy-MM-dd` date strings. See the
;; `auto-bucket-datetimes` middleware for more details. `:field` clauses elsewhere will not be automatically
;; bucketed, so drivers still need to make sure they do any special datetime handling for plain `:field`
;; clauses when their FieldOrExpression derives from `:type/DateTime`.
[:temporal-unit {:optional true} [:maybe DateTimeUnit]]
;;
;; replaces `joined-field`
;;
;; `:join-alias` is used to refer to a FieldOrExpression from a different Table/nested query that you are
;; EXPLICITLY JOINING against.
[:join-alias {:optional true} [:maybe NonBlankString]]
;;
;; replaces `binning-strategy`
;;
;; Using binning requires the driver to support the `:binning` feature.
[:binning {:optional true} [:maybe FieldBinningOptions]]]
validate-temporal-unit
no-binning-options-at-top-level)) | |
(def ^:private FieldOptions [:ref ::FieldOptions]) | |
(defn- require-base-type-for-field-name [schema]
[:and
schema
[:fn
{:error/message ":field clauses using a string field name must specify :base-type."}
(fn [[_ id-or-name {:keys [base-type]}]]
(if (string? id-or-name)
base-type
true))]]) | |
(mr/def ::field
(-> (helpers/clause
:field
"id-or-name" [:or FieldID NonBlankString]
"options" [:maybe FieldOptions])
require-base-type-for-field-name)) | |
Schema for a | (def ^{:clause-name :field, :added "0.39.0"} field
[:ref ::field]) |
(def ^{:clause-name :field, :added "0.39.0"} field:id
"Schema for a `:field` clause, with the added constraint that it must use an integer Field ID."
[:and
field
[:fn
{:error/message "Must be a :field with an integer Field ID."}
(fn [[_ id-or-name]]
(integer? id-or-name))]]) | |
(mr/def ::Field (one-of expression field)) | |
Schema for either a | (def Field [:ref ::Field]) |
aggregate field reference refers to an aggregation, e.g. {:aggregation [[:count]]
:order-by [[:asc [:aggregation 0]]]} ;; refers to the 0th aggregation, Currently aggregate Field references can only be used inside order-by clauses. In the future once we support SQL
TODO - shouldn't we allow composing aggregations in expressions? e.g. {:order-by [[:asc [:+ [:aggregation 0] [:aggregation 1]]]]} TODO - it would be nice if we could check that there's actually an aggregation with the corresponding index, wouldn't it As of 0.42.0 | (defclause aggregation aggregation-clause-index :int options (optional :map)) |
(mr/def ::Reference (one-of aggregation expression field)) | |
Schema for any type of valid Field clause, or for an indexed reference to an aggregation clause. | (def Reference [:ref ::Reference]) |
-------------------------------------------------- Expressions --------------------------------------------------- | |
Expressions are "calculated column" definitions, defined once and then used elsewhere in the MBQL query. | |
Functions that return string values. Should match [[StringExpression]]. | (def string-functions
#{:substring :trim :rtrim :ltrim :upper :lower :replace :concat :regex-match-first :coalesce :case}) |
Schema for the definition of an string expression. | (def ^:private StringExpression [:ref ::StringExpression]) |
(mr/def ::StringExpressionArg
[:multi
{:dispatch (fn [x]
(cond
(string? x) :string
(is-clause? string-functions x) :string-expression
(is-clause? :value x) :value
:else :else))}
[:string :string]
[:string-expression StringExpression]
[:value value]
[:else Field]]) | |
(def ^:private StringExpressionArg [:ref ::StringExpressionArg]) | |
Functions that return numeric values. Should match [[NumericExpression]]. | (def numeric-functions
#{:+ :- :/ :* :coalesce :length :round :ceil :floor :abs :power :sqrt :log :exp :case :datetime-diff
;; extraction functions (get some component of a given temporal value/column)
:temporal-extract
;; SUGAR drivers do not need to implement
:get-year :get-quarter :get-month :get-week :get-day :get-day-of-week :get-hour :get-minute :get-second}) |
Functions that return boolean values. Should match [[BooleanExpression]]. | (def ^:private boolean-functions
#{:and :or :not :< :<= :> :>= := :!=}) |
(def ^:private aggregations
#{:sum :avg :stddev :var :median :percentile :min :max :cum-count :cum-sum :count-where :sum-where :share :distinct
:metric :aggregation-options :count}) | |
Functions that return Date or DateTime values. Should match [[DatetimeExpression]]. | (def ^:private datetime-functions
#{:+ :datetime-add :datetime-subtract :convert-timezone :now}) |
Schema for the definition of a numeric expression. All numeric expressions evaluate to numeric values. | (def ^:private NumericExpression [:ref ::NumericExpression]) |
Schema for the definition of an arithmetic expression. | (def ^:private BooleanExpression [:ref ::BooleanExpression]) |
Schema for the definition of a date function expression. | (def DatetimeExpression [:ref ::DatetimeExpression]) |
Schema for anything that is a valid | (def Aggregation [:ref ::Aggregation]) |
(mr/def ::NumericExpressionArg
[:multi
{:error/message "numeric expression argument"
:dispatch (fn [x]
(cond
(number? x) :number
(is-clause? numeric-functions x) :numeric-expression
(is-clause? aggregations x) :aggregation
(is-clause? :value x) :value
:else :field))}
[:number number?]
[:numeric-expression NumericExpression]
[:aggregation Aggregation]
[:value value]
[:field Field]]) | |
(def ^:private NumericExpressionArg [:ref ::NumericExpressionArg]) | |
(mr/def ::DateTimeExpressionArg
[:multi
{:error/message "datetime expression argument"
:dispatch (fn [x]
(cond
(is-clause? aggregations x) :aggregation
(is-clause? :value x) :value
(is-clause? datetime-functions x) :datetime-expression
:else :else))}
[:aggregation Aggregation]
[:value value]
[:datetime-expression DatetimeExpression]
[:else [:or DateOrDatetimeLiteral Field]]]) | |
(def ^:private DateTimeExpressionArg [:ref ::DateTimeExpressionArg]) | |
(mr/def ::ExpressionArg
[:multi
{:error/message "expression argument"
:dispatch (fn [x]
(cond
(number? x) :number
(boolean? x) :boolean
(is-clause? boolean-functions x) :boolean-expression
(is-clause? numeric-functions x) :numeric-expression
(is-clause? datetime-functions x) :datetime-expression
(string? x) :string
(is-clause? string-functions x) :string-expression
(is-clause? :value x) :value
:else :else))}
[:number number?]
[:boolean :boolean]
[:boolean-expression BooleanExpression]
[:numeric-expression NumericExpression]
[:datetime-expression DatetimeExpression]
[:string :string]
[:string-expression StringExpression]
[:value value]
[:else Field]]) | |
(def ^:private ExpressionArg [:ref ::ExpressionArg]) | |
(mr/def ::NumericExpressionArgOrInterval
[:or
{:error/message "numeric expression arg or interval"}
interval
NumericExpressionArg]) | |
(def ^:private NumericExpressionArgOrInterval [:ref ::NumericExpressionArgOrInterval]) | |
(mr/def ::IntGreaterThanZeroOrNumericExpression
[:multi
{:error/message "int greater than zero or numeric expression"
:dispatch (fn [x]
(if (number? x)
:number
:else))}
[:number PositiveInt]
[:else NumericExpression]]) | |
(def ^:private IntGreaterThanZeroOrNumericExpression [:ref ::IntGreaterThanZeroOrNumericExpression]) | |
(defclause ^{:requires-features #{:expressions}} coalesce
a ExpressionArg, b ExpressionArg, more (rest ExpressionArg)) | |
(defclause ^{:requires-features #{:expressions}} substring
s StringExpressionArg, start IntGreaterThanZeroOrNumericExpression, length (optional NumericExpressionArg)) | |
(defclause ^{:requires-features #{:expressions}} length
s StringExpressionArg) | |
(defclause ^{:requires-features #{:expressions}} trim
s StringExpressionArg) | |
(defclause ^{:requires-features #{:expressions}} rtrim
s StringExpressionArg) | |
(defclause ^{:requires-features #{:expressions}} ltrim
s StringExpressionArg) | |
(defclause ^{:requires-features #{:expressions}} upper
s StringExpressionArg) | |
(defclause ^{:requires-features #{:expressions}} lower
s StringExpressionArg) | |
(defclause ^{:requires-features #{:expressions}} replace
s StringExpressionArg, match :string, replacement :string) | |
(defclause ^{:requires-features #{:expressions}} concat
a StringExpressionArg, b StringExpressionArg, more (rest StringExpressionArg)) | |
(defclause ^{:requires-features #{:expressions :regex}} regex-match-first
s StringExpressionArg, pattern :string) | |
(defclause ^{:requires-features #{:expressions}} +
x NumericExpressionArgOrInterval, y NumericExpressionArgOrInterval, more (rest NumericExpressionArgOrInterval)) | |
(defclause ^{:requires-features #{:expressions}} -
x NumericExpressionArg, y NumericExpressionArgOrInterval, more (rest NumericExpressionArgOrInterval)) | |
(defclause ^{:requires-features #{:expressions}} /, x NumericExpressionArg, y NumericExpressionArg, more (rest NumericExpressionArg)) | |
(defclause ^{:requires-features #{:expressions}} *, x NumericExpressionArg, y NumericExpressionArg, more (rest NumericExpressionArg)) | |
(defclause ^{:requires-features #{:expressions}} floor
x NumericExpressionArg) | |
(defclause ^{:requires-features #{:expressions}} ceil
x NumericExpressionArg) | |
(defclause ^{:requires-features #{:expressions}} round
x NumericExpressionArg) | |
(defclause ^{:requires-features #{:expressions}} abs
x NumericExpressionArg) | |
(defclause ^{:requires-features #{:advanced-math-expressions}} power
x NumericExpressionArg, y NumericExpressionArg) | |
(defclause ^{:requires-features #{:advanced-math-expressions}} sqrt
x NumericExpressionArg) | |
(defclause ^{:requires-features #{:advanced-math-expressions}} exp
x NumericExpressionArg) | |
(defclause ^{:requires-features #{:advanced-math-expressions}} log
x NumericExpressionArg) | |
The result is positive if x <= y, and negative otherwise. Days, weeks, months, and years are only counted if they are whole to the "day".
For example, If the values are datetimes, the time doesn't matter for these units.
For example, Hours, minutes, and seconds are only counted if they are whole. For example, datetimeDiff("2022-01-01T01:00:30", "2022-01-01T02:00:29", "hour") returns 0 hours. | (defclause ^{:requires-features #{:datetime-diff}} datetime-diff
datetime-x DateTimeExpressionArg
datetime-y DateTimeExpressionArg
unit DatetimeDiffUnit) |
(defclause ^{:requires-features #{:temporal-extract}} temporal-extract
datetime DateTimeExpressionArg
unit TemporalExtractUnit
mode (optional ExtractWeekMode)) ;; only for get-week | |
only for get-week | |
SUGAR CLAUSE: get-year, get-month... clauses are all sugars clause that will be rewritten as [:temporal-extract column :year] | (defclause ^{:requires-features #{:temporal-extract}} ^:sugar get-year
date DateTimeExpressionArg) |
(defclause ^{:requires-features #{:temporal-extract}} ^:sugar get-quarter
date DateTimeExpressionArg) | |
(defclause ^{:requires-features #{:temporal-extract}} ^:sugar get-month
date DateTimeExpressionArg) | |
(defclause ^{:requires-features #{:temporal-extract}} ^:sugar get-week
date DateTimeExpressionArg
mode (optional ExtractWeekMode)) | |
(defclause ^{:requires-features #{:temporal-extract}} ^:sugar get-day
date DateTimeExpressionArg) | |
(defclause ^{:requires-features #{:temporal-extract}} ^:sugar get-day-of-week
date DateTimeExpressionArg) | |
(defclause ^{:requires-features #{:temporal-extract}} ^:sugar get-hour
datetime DateTimeExpressionArg) | |
(defclause ^{:requires-features #{:temporal-extract}} ^:sugar get-minute
datetime DateTimeExpressionArg) | |
(defclause ^{:requires-features #{:temporal-extract}} ^:sugar get-second
datetime DateTimeExpressionArg) | |
(defclause ^{:requires-features #{:convert-timezone}} convert-timezone
datetime DateTimeExpressionArg
to TimezoneId
from (optional TimezoneId)) | |
(def ^:private ArithmeticDateTimeUnit
[:enum {:error/message "datetime arithmetic unit"} :millisecond :second :minute :hour :day :week :month :quarter :year]) | |
(defclause ^{:requires-features #{:date-arithmetics}} datetime-add
datetime DateTimeExpressionArg
amount NumericExpressionArg
unit ArithmeticDateTimeUnit) | |
(defclause ^{:requires-features #{:now}} now) | |
(defclause ^{:requires-features #{:date-arithmetics}} datetime-subtract
datetime DateTimeExpressionArg
amount NumericExpressionArg
unit ArithmeticDateTimeUnit) | |
(mr/def ::DatetimeExpression (one-of + datetime-add datetime-subtract convert-timezone now)) | |
----------------------------------------------------- Filter ----------------------------------------------------- | |
Schema for a valid MBQL | (def Filter [:ref ::Filter]) |
(defclause and first-clause Filter second-clause Filter other-clauses (rest Filter)) | |
(defclause or first-clause Filter second-clause Filter other-clauses (rest Filter)) | |
(defclause not, clause Filter) | |
(def ^:private FieldOrExpressionRefOrRelativeDatetime
[:multi
{:error/message ":field or :expression reference or :relative-datetime"
:error/fn (constantly ":field or :expression reference or :relative-datetime")
:dispatch (fn [x]
(if (is-clause? :relative-datetime x)
:relative-datetime
:else))}
[:relative-datetime relative-datetime]
[:else Field]]) | |
(mr/def ::EqualityComparable
[:maybe
{:error/message "equality comparable"}
[:or
:boolean
number?
:string
TemporalLiteral
FieldOrExpressionRefOrRelativeDatetime
ExpressionArg
value]]) | |
Schema for things that make sense in a | (def ^:private EqualityComparable [:ref ::EqualityComparable]) |
(mr/def ::OrderComparable
[:multi
{:error/message "order comparable"
:dispatch (fn [x]
(if (is-clause? :value x)
:value
:else))}
[:value value]
[:else [:or
number?
:string
TemporalLiteral
ExpressionArg
FieldOrExpressionRefOrRelativeDatetime]]]) | |
Schema for things that make sense in a filter like | (def ^:private OrderComparable [:ref ::OrderComparable]) |
For all of the non-compound Filter clauses below the first arg is an implicit Field ID | |
These are SORT OF SUGARY, because extra values will automatically be converted a compound clauses. Driver implementations only need to handle the 2-arg forms.
[:= [:field 1 nil] 2 3] --[DESUGAR]--> [:or [:= [:field 1 nil] 2] [:= [:field 1 nil] 3]]
[:!= [:field 1 nil] 2 3] --[DESUGAR]--> [:and [:!= [:field 1 nil] 2] [:!= [:field 1 nil] 3]] | |
(defclause =, field EqualityComparable, value-or-field EqualityComparable, more-values-or-fields (rest EqualityComparable)) (defclause !=, field EqualityComparable, value-or-field EqualityComparable, more-values-or-fields (rest EqualityComparable)) | |
(defclause <, field OrderComparable, value-or-field OrderComparable) (defclause >, field OrderComparable, value-or-field OrderComparable) (defclause <=, field OrderComparable, value-or-field OrderComparable) (defclause >=, field OrderComparable, value-or-field OrderComparable) | |
:between is INCLUSIVE just like SQL !!! | (defclause between field OrderComparable, min OrderComparable, max OrderComparable) |
SUGAR CLAUSE: This is automatically written as a pair of | (defclause ^:sugar inside lat-field OrderComparable lon-field OrderComparable lat-max OrderComparable lon-min OrderComparable lat-min OrderComparable lon-max OrderComparable) |
SUGAR CLAUSES: These are rewritten as | (defclause ^:sugar is-null, field Field) (defclause ^:sugar not-null, field Field) |
These are rewritten as | (defclause ^:sugar is-empty, field Field) (defclause ^:sugar not-empty, field Field) |
(def ^:private StringFilterOptions
[:map
;; default true
[:case-sensitive {:optional true} :boolean]]) | |
(defclause starts-with, field StringExpressionArg, string-or-field StringExpressionArg, options (optional StringFilterOptions)) (defclause ends-with, field StringExpressionArg, string-or-field StringExpressionArg, options (optional StringFilterOptions)) (defclause contains, field StringExpressionArg, string-or-field StringExpressionArg, options (optional StringFilterOptions)) | |
SUGAR: this is rewritten as [:not [:contains ...]] | (defclause ^:sugar does-not-contain field StringExpressionArg, string-or-field StringExpressionArg, options (optional StringFilterOptions)) |
(def ^:private TimeIntervalOptions
;; Should we include partial results for the current day/month/etc? Defaults to `false`; set this to `true` to
;; include them.
[:map
;; default false
[:include-current {:optional true} :boolean]]) | |
Filter subclause. Syntactic sugar for specifying a specific time interval. Return rows where datetime Field 100's value is in the current month [:time-interval [:field 100 nil] :current :month] Return rows where datetime Field 100's value is in the current month, including partial results for the current day [:time-interval [:field 100 nil] :current :month {:include-current true}] SUGAR: This is automatically rewritten as a filter clause with a relative-datetime value | (defclause ^:sugar time-interval
field Field
n [:or
:int
[:enum :current :last :next]]
unit RelativeDatetimeUnit
options (optional TimeIntervalOptions)) |
A segment is a special It can also be used for GA, which looks something like | (def ^:private SegmentID [:ref ::lib.schema.id/segment]) |
(defclause ^:sugar segment segment-id [:or SegmentID NonBlankString]) | |
(mr/def ::BooleanExpression (one-of and or not < <= > >= = !=)) | |
(mr/def ::Filter
[:multi
{:error/message "valid filter expression"
:dispatch (fn [x]
(cond
(is-clause? datetime-functions x) :datetime
(is-clause? numeric-functions x) :numeric
(is-clause? string-functions x) :string
(is-clause? boolean-functions x) :boolean
:else :else))}
[:datetime DatetimeExpression]
[:numeric NumericExpression]
[:string StringExpression]
[:boolean BooleanExpression]
[:else (one-of
;; filters drivers must implement
and or not = != < > <= >= between starts-with ends-with contains
;; SUGAR filters drivers do not need to implement
does-not-contain inside is-empty not-empty is-null not-null time-interval segment)]]) | |
(def ^:private CaseClause
[:tuple {:error/message ":case subclause"} Filter ExpressionArg]) | |
(def ^:private CaseClauses [:maybe [:sequential CaseClause]]) | |
(def ^:private CaseOptions
[:map
{:error/message ":case options"}
[:default {:optional true} ExpressionArg]]) | |
(defclause ^{:requires-features #{:basic-aggregations}} case
clauses CaseClauses, options (optional CaseOptions)) | |
(mr/def ::NumericExpression
(one-of + - / * coalesce length floor ceil round abs power sqrt exp log case datetime-diff
temporal-extract get-year get-quarter get-month get-week get-day get-day-of-week
get-hour get-minute get-second)) | |
(mr/def ::StringExpression (one-of substring trim ltrim rtrim replace lower upper concat regex-match-first coalesce case)) | |
Schema for anything that is accepted as a top-level expression definition, either an arithmetic expression such as a
| (def FieldOrExpressionDef
[:multi
{:error/message ":field or :expression reference or expression"
:dispatch (fn [x]
(cond
(is-clause? numeric-functions x) :numeric
(is-clause? string-functions x) :string
(is-clause? boolean-functions x) :boolean
(is-clause? datetime-functions x) :datetime
(is-clause? :case x) :case
:else :else))}
[:numeric NumericExpression]
[:string StringExpression]
[:boolean BooleanExpression]
[:datetime DatetimeExpression]
[:case case]
[:else Field]]) |
-------------------------------------------------- Aggregations -------------------------------------------------- | |
For all of the 'normal' Aggregations below (excluding Metrics) fields are implicit Field IDs | |
cum-sum and cum-count are SUGAR because they're implemented in middleware. The clauses are swapped out with
| (defclause ^{:requires-features #{:basic-aggregations}} ^:sugar count, field (optional Field))
(defclause ^{:requires-features #{:basic-aggregations}} ^:sugar cum-count, field (optional Field)) |
technically aggregations besides count can also accept expressions as args, e.g. [[:sum [:+ [:field 1 nil] [:field 2 nil]]]] Which is equivalent to SQL: SUM(field1 + field2) | |
(defclause ^{:requires-features #{:basic-aggregations}} avg, field-or-expression FieldOrExpressionDef)
(defclause ^{:requires-features #{:basic-aggregations}} cum-sum, field-or-expression FieldOrExpressionDef)
(defclause ^{:requires-features #{:basic-aggregations}} distinct, field-or-expression FieldOrExpressionDef)
(defclause ^{:requires-features #{:basic-aggregations}} sum, field-or-expression FieldOrExpressionDef)
(defclause ^{:requires-features #{:basic-aggregations}} min, field-or-expression FieldOrExpressionDef)
(defclause ^{:requires-features #{:basic-aggregations}} max, field-or-expression FieldOrExpressionDef) | |
(defclause ^{:requires-features #{:basic-aggregations}} sum-where
field-or-expression FieldOrExpressionDef, pred Filter) | |
(defclause ^{:requires-features #{:basic-aggregations}} count-where
pred Filter) | |
(defclause ^{:requires-features #{:basic-aggregations}} share
pred Filter) | |
(defclause ^{:requires-features #{:standard-deviation-aggregations}} stddev
field-or-expression FieldOrExpressionDef) | |
(defclause ^{:requires-features #{:standard-deviation-aggregations}} [ag:var var]
field-or-expression FieldOrExpressionDef) | |
(defclause ^{:requires-features #{:percentile-aggregations}} median
field-or-expression FieldOrExpressionDef) | |
(defclause ^{:requires-features #{:percentile-aggregations}} percentile
field-or-expression FieldOrExpressionDef, percentile NumericExpressionArg) | |
Metrics are just 'macros' (placeholders for other aggregations with optional filter and breakout clauses) that get expanded to other aggregations/etc. in the expand-macros middleware METRICS WITH STRING IDS, e.g. | (def ^:private MetricID [:ref ::lib.schema.id/metric]) |
(defclause metric metric-id [:or MetricID NonBlankString]) | |
the following are definitions for expression aggregations, e.g. [:+ [:sum [:field 10 nil]] [:sum [:field 20 nil]]] | |
(mr/def ::UnnamedAggregation
[:multi
{:error/message "unnamed aggregation clause or numeric expression"
:dispatch (fn [x]
(if (is-clause? numeric-functions x)
:numeric-expression
:else))}
[:numeric-expression NumericExpression]
[:else (one-of avg cum-sum distinct stddev sum min max metric share count-where
sum-where case median percentile ag:var
;; SUGAR clauses
cum-count count)]]) | |
(def ^:private UnnamedAggregation ::UnnamedAggregation) | |
Additional options for any aggregation clause when wrapping it in | (def ^:private AggregationOptions
[:map
{:error/message ":aggregation-options options"}
;; name to use for this aggregation in the native query instead of the default name (e.g. `count`)
[:name {:optional true} NonBlankString]
;; user-facing display name for this aggregation instead of the default one
[:display-name {:optional true} NonBlankString]]) |
(defclause aggregation-options aggregation UnnamedAggregation options AggregationOptions) | |
(mr/def ::Aggregation
[:multi
{:error/message "aggregation clause or numeric expression"
:dispatch (fn [x]
(if (is-clause? :aggregation-options x)
:aggregation-options
:unnamed-aggregation))}
[:aggregation-options aggregation-options]
[:unnamed-aggregation UnnamedAggregation]]) | |
---------------------------------------------------- Order-By ---------------------------------------------------- | |
order-by is just a series of {:order-by [[:asc [:field 1 nil]], [:desc [:field 2 nil]]]} Field ID is implicit in these clauses | |
(defclause asc, field Reference) (defclause desc, field Reference) | |
Schema for an | (def OrderBy (one-of asc desc)) |
+----------------------------------------------------------------------------------------------------------------+ | Queries | +----------------------------------------------------------------------------------------------------------------+ | |
---------------------------------------------- Native [Inner] Query ---------------------------------------------- | |
Template tags are used to specify {{placeholders}} in native queries that are replaced with some sort of value when the query itself runs. There are four basic types of template tag for native queries:
Field filters and raw values usually have their value specified by | |
Schema for valid values of template tag | (def ^:private TemplateTagType [:enum :snippet :card :dimension :number :text :date]) |
(def ^:private TemplateTag:Common
"Things required by all template tag types."
[:map
[:type TemplateTagType]
[:name NonBlankString]
[:display-name NonBlankString]
;; TODO -- `:id` is actually 100% required but we have a lot of tests that don't specify it because this constraint
;; wasn't previously enforced; we need to go in and fix those tests and make this non-optional
[:id {:optional true} NonBlankString]]) | |
Example: {:id "c2fc7310-44eb-4f21-c3a0-63806ffb7ddd" :name "snippet: select" :display-name "Snippet: select" :type :snippet :snippet-name "select" :snippet-id 1} | (def ^:private TemplateTag:Snippet
"Schema for a native query snippet template tag."
[:merge
TemplateTag:Common
[:map
[:type [:= :snippet]]
[:snippet-name NonBlankString]
[:snippet-id PositiveInt]
;; database to which this Snippet belongs. Doesn't always seen to be specified.
[:database {:optional true} PositiveInt]]]) |
Example: {:id "fc5e14d9-7d14-67af-66b2-b2a6e25afeaf" :name "#1635" :display-name "#1635" :type :card :card-id 1635} | (def ^:private TemplateTag:SourceQuery
"Schema for a source query template tag."
[:merge
TemplateTag:Common
[:map
[:type [:= :card]]
[:card-id PositiveInt]]]) |
(def ^:private TemplateTag:Value:Common
"Stuff shared between the Field filter and raw value template tag schemas."
[:merge
TemplateTag:Common
[:map
;; default value for this parameter
[:default {:optional true} :any]
;; whether or not a value for this parameter is required in order to run the query
[:required {:optional true} :boolean]]]) | |
Schema for valid values of | (def ^:private ParameterType [:ref ::ParameterType]) |
Schema for valid values of | (def ^:private WidgetType [:ref ::WidgetType]) |
Example: {:id "c20851c7-8a80-0ffa-8a99-ae636f0e9539" :name "date" :display-name "Date" :type :dimension, :dimension [:field 4 nil] :widget-type :date/all-options} | (def ^:private TemplateTag:FieldFilter
"Schema for a field filter template tag."
[:merge
TemplateTag:Value:Common
[:map
[:type [:= :dimension]]
[:dimension field]
;; which type of widget the frontend should show for this Field Filter; this also affects which parameter types
;; are allowed to be specified for it.
[:widget-type WidgetType]
;; optional map to be appended to filter clause
[:options {:optional true} [:map-of :keyword :any]]]]) |
Set of valid values of | (def raw-value-template-tag-types
#{:number :text :date :boolean}) |
(def ^:private TemplateTag:RawValue:Type "Valid values of `:type` for raw value template tags." (into [:enum] raw-value-template-tag-types)) | |
Example: {:id "35f1ecd4-d622-6d14-54be-750c498043cb" :name "id" :display-name "Id" :type :number :required true :default "1"} | (def ^:private TemplateTag:RawValue
"Schema for a raw value template tag."
[:merge
TemplateTag:Value:Common
;; `:type` is used be the FE to determine which type of widget to display for the template tag, and to determine
;; which types of parameters are allowed to be passed in for this template tag.
[:map
[:type TemplateTag:RawValue:Type]]]) |
TODO -- if we were using core.spec here I would make this a multimethod-based spec instead and have it dispatch off
of | |
(mr/def ::TemplateTag
[:multi
{:dispatch :type}
[:dimension TemplateTag:FieldFilter]
[:snippet TemplateTag:Snippet]
[:card TemplateTag:SourceQuery]
[::mc/default TemplateTag:RawValue]]) | |
Schema for a template tag as specified in a native query. There are four types of template tags, differentiated by
| (def TemplateTag [:ref ::TemplateTag]) |
Schema for the | (def ^:private TemplateTagMap
;; map of template tag name -> template tag definition
[:and
[:map-of NonBlankString TemplateTag]
;; make sure people don't try to pass in a `:name` that's different from the actual key in the map.
[:fn
{:error/message "keys in template tag map must match the :name of their values"}
(fn [m]
(every? (fn [[tag-name tag-definition]]
(core/= tag-name (:name tag-definition)))
m))]]) |
(def ^:private NativeQuery:Common
[:map
[:template-tags {:optional true} TemplateTagMap]
;; collection (table) this query should run against. Needed for MongoDB
[:collection {:optional true} [:maybe NonBlankString]]]) | |
Schema for a valid, normalized native [inner] query. | (def NativeQuery
[:merge
NativeQuery:Common
[:map
[:query :any]]]) |
(def ^:private NativeSourceQuery
[:merge
NativeQuery:Common
[:map
[:native :any]]]) | |
----------------------------------------------- MBQL [Inner] Query ----------------------------------------------- | |
Schema for a valid, normalized MBQL [inner] query. | (def MBQLQuery [:ref ::MBQLQuery]) |
Schema for a valid value for a | (def SourceQuery
[:multi
{:dispatch (fn [x]
(if ((every-pred map? :native) x)
:native
:mbql))}
;; when using native queries as source queries the schema is exactly the same except use `:native` in place of
;; `:query` for reasons I do not fully remember (perhaps to make it easier to differentiate them from MBQL source
;; queries).
[:native NativeSourceQuery]
[:mbql MBQLQuery]]) |
Schema for the expected keys for a single column in This metadata automatically gets added for all source queries that are referenced via the | (def SourceQueryMetadata
;; TODO - there is a very similar schema in `metabase.sync.analyze.query-results`; see if we can merge them
[:map
[:name NonBlankString]
[:base_type BaseType]
;; this is only used by the annotate post-processing stage, not really needed at all for pre-processing, might be
;; able to remove this as a requirement
[:display_name NonBlankString]
[:semantic_type {:optional true} [:maybe SemanticOrRelationType]]
;; you'll need to provide this in order to use BINNING
[:fingerprint {:optional true} [:maybe :map]]]) |
Pattern that matches | (def source-table-card-id-regex #"^card__[1-9]\d*$") |
Schema for a valid value for the | (def ^:private SourceTable
[:or
TableID
[:re
{:error/message "'card__<id>' string Table ID"}
source-table-card-id-regex]]) |
Valid values of the | (def join-strategies
#{:left-join :right-join :inner-join :full-join}) |
Strategy that should be used to perform the equivalent of a SQL | (def ^:private JoinStrategy (into [:enum] join-strategies)) |
Schema for valid values of the MBQL | (def Fields [:ref ::Fields]) |
(def ^:private JoinFields
[:or
{:error/message "Valid join `:fields`: `:all`, `:none`, or a sequence of `:field` clauses that have `:join-alias`."}
[:enum :all :none]
Fields]) | |
(mr/def ::Join
[:and
[:map
;; *What* to JOIN. Self-joins can be done by using the same `:source-table` as in the query where this is specified.
;; YOU MUST SUPPLY EITHER `:source-table` OR `:source-query`, BUT NOT BOTH!
[:source-table {:optional true} SourceTable]
[:source-query {:optional true} SourceQuery]
;;
;; The condition on which to JOIN. Can be anything that is a valid `:filter` clause. For automatically-generated
;; JOINs this is always
;;
;; [:= <source-table-fk-field> [:field <dest-table-pk-field> {:join-alias <join-table-alias>}]]
;;
[:condition Filter]
;;
;; Defaults to `:left-join`; used for all automatically-generated JOINs
;;
;; Driver implementations: this is guaranteed to be present after pre-processing.
[:strategy {:optional true} JoinStrategy]
;;
;; The Field to include in the results *if* a top-level `:fields` clause *is not* specified. This can be either
;; `:none`, `:all`, or a sequence of Field clauses.
;;
;; * `:none`: no Fields from the joined table or nested query are included (unless indirectly included by
;; breakouts or other clauses). This is the default, and what is used for automatically-generated joins.
;;
;; * `:all`: will include all of the Field from the joined table or query
;;
;; * a sequence of Field clauses: include only the Fields specified. Valid clauses are the same as the top-level
;; `:fields` clause. This should be non-empty and all elements should be distinct. The normalizer will
;; automatically remove duplicate fields for you, and replace empty clauses with `:none`.
;;
;; Driver implementations: you can ignore this clause. Relevant fields will be added to top-level `:fields` clause
;; with appropriate aliases.
[:fields {:optional true} JoinFields]
;;
;; The name used to alias the joined table or query. This is usually generated automatically and generally looks
;; like `table__via__field`. You can specify this yourself if you need to reference a joined field with a
;; `:join-alias` in the options.
;;
;; Driver implementations: This is guaranteed to be present after pre-processing.
[:alias {:optional true} NonBlankString]
;;
;; Used internally, only for annotation purposes in post-processing. When a join is implicitly generated via a
;; `:field` clause with `:source-field`, the ID of the foreign key field in the source Table will
;; be recorded here. This information is used to add `fk_field_id` information to the `:cols` in the query
;; results; I believe this is used to facilitate drill-thru? :shrug:
;;
;; Don't set this information yourself. It will have no effect.
[:fk-field-id {:optional true} [:maybe FieldID]]
;;
;; Metadata about the source query being used, if pulled in from a Card via the `:source-table "card__id"` syntax.
;; added automatically by the `resolve-card-id-source-tables` middleware.
[:source-metadata {:optional true} [:maybe [:sequential SourceQueryMetadata]]]]
[:fn
{:error/message "Joins must have either a `source-table` or `source-query`, but not both."}
(every-pred
(some-fn :source-table :source-query)
(complement (every-pred :source-table :source-query)))]]) | |
Perform the equivalent of a SQL In the top-level query, you can reference Fields from the joined table or nested query by including ;; for joins against other Tables/MBQL source queries [:field 1 {:join-alias "myjoinalias"}] ;; for joins against native queries [:field "myfield" {:base-type :field/Integer, :join-alias "myjoin_alias"}] | (def Join [:ref ::Join]) |
(mr/def ::Joins
[:and
(helpers/non-empty [:sequential Join])
[:fn
{:error/message "All join aliases must be unique."}
#(helpers/empty-or-distinct? (filter some? (map :alias %)))]]) | |
Schema for a valid sequence of | (def ^:private Joins [:ref ::Joins]) |
(mr/def ::Fields
[:schema
{:error/message "Distinct, non-empty sequence of Field clauses"}
(helpers/distinct [:sequential {:min 1} Field])]) | |
(def ^:private Page [:map [:page PositiveInt] [:items PositiveInt]]) | |
(mr/def ::MBQLQuery
[:and
[:map
[:source-query {:optional true} SourceQuery]
[:source-table {:optional true} SourceTable]
[:aggregation {:optional true} [:sequential {:min 1} Aggregation]]
[:breakout {:optional true} [:sequential {:min 1} Field]]
[:expressions {:optional true} [:map-of NonBlankString FieldOrExpressionDef]]
[:fields {:optional true} Fields]
[:filter {:optional true} Filter]
[:limit {:optional true} IntGreaterThanOrEqualToZero]
[:order-by {:optional true} (helpers/distinct [:sequential {:min 1} OrderBy])]
;; page = page num, starting with 1. items = number of items per page.
;; e.g.
;; {:page 1, :items 10} = items 1-10
;; {:page 2, :items 10} = items 11-20
[:page {:optional true} Page]
;;
;; Various bits of middleware add additonal keys, such as `fields-is-implicit?`, to record bits of state or pass
;; info to other pieces of middleware. Everyone else can ignore them.
[:joins {:optional true} Joins]
;;
;; Info about the columns of the source query. Added in automatically by middleware. This metadata is primarily
;; used to let power things like binning when used with Field Literals instead of normal Fields
[:source-metadata {:optional true} [:maybe [:sequential SourceQueryMetadata]]]]
;;
;; CONSTRAINTS
;;
[:fn
{:error/message "Query must specify either `:source-table` or `:source-query`, but not both."}
(fn [query]
(core/= 1 (core/count (select-keys query [:source-query :source-table]))))]
[:fn
{:error/message "Fields specified in `:breakout` should not be specified in `:fields`; this is implied."}
(fn [{:keys [breakout fields]}]
(empty? (set/intersection (set breakout) (set fields))))]]) | |
----------------------------------------------------- Params ----------------------------------------------------- | |
| |
There are three things called 'type' in play when we talk about parameters and template tags. Two are used when the parameters are specified/declared, in a [[TemplateTag]] or in a Dashboard parameter:
One type is used in the [[Parameter]] list (
Note that some types that makes sense as widget types (e.g. | |
Map of parameter-type -> info. Info is a map with the following keys: `:type`The general type of this parameter. `:operator`Signifies this is one of the new 'operator' parameter types added in 0.39.0 or so. These parameters can only be used
for [[TemplateTag:FieldFilter]]s or for Dashboard parameters mapped to MBQL queries. The value of this key is the
arity for the parameter, either `:allowed-for`[[Parameter]]s with this | (def parameter-types
{;; the basic raw-value types. These can be used with [[TemplateTag:RawValue]] template tags as well as
;; [[TemplateTag:FieldFilter]] template tags.
:number {:type :numeric, :allowed-for #{:number :number/= :id :category :location/zip_code}}
:text {:type :string, :allowed-for #{:text :string/= :id :category
:location/city :location/state :location/zip_code :location/country}}
:date {:type :date, :allowed-for #{:date :date/single :date/all-options :id :category}}
;; I don't think `:boolean` is actually used on the FE at all.
:boolean {:type :boolean, :allowed-for #{:boolean :id :category}}
;; as far as I can tell this is basically just an alias for `:date`... I'm not sure what the difference is TBH
:date/single {:type :date, :allowed-for #{:date :date/single :date/all-options :id :category}}
;; everything else can't be used with raw value template tags -- they can only be used with Dashboard parameters
;; for MBQL queries or Field filters in native queries
;; `:id` and `:category` conceptually aren't types in a "the parameter value is of this type" sense, but they are
;; widget types. They have something to do with telling the frontend to show FieldValues list/search widgets or
;; something like that.
;;
;; Apparently the frontend might still pass in parameters with these types, in which case we're supposed to infer
;; the actual type of the parameter based on the Field we're filtering on. Or something like that. Parameters with
;; these types are only allowed if the widget type matches exactly, but you can also pass in something like a
;; `:number/=` for a parameter with widget type `:category`.
;;
;; TODO FIXME -- actually, it turns out the the FE client passes parameter type `:category` for parameters in
;; public Cards. Who knows why! For now, we'll continue allowing it. But we should fix it soon. See
;; [[metabase.api.public-test/execute-public-card-with-parameters-test]]
:id {:allowed-for #{:id}}
:category {:allowed-for #{:category #_FIXME :number :text :date :boolean}}
;; Like `:id` and `:category`, the `:location/*` types are primarily widget types. They don't really have a meaning
;; as a parameter type, so in an ideal world they wouldn't be allowed; however it seems like the FE still passed
;; these in as parameter type on occasion anyway. In this case the backend is just supposed to infer the actual
;; type -- which should be `:text` and, in the case of ZIP code, possibly `:number`.
;;
;; As with `:id` and `:category`, it would be preferable to just pass in a parameter with type `:text` or `:number`
;; for these widget types, but for compatibility we'll allow them to continue to be used as parameter types for the
;; time being. We'll only allow that if the widget type matches exactly, however.
:location/city {:allowed-for #{:location/city}}
:location/state {:allowed-for #{:location/state}}
:location/zip_code {:allowed-for #{:location/zip_code}}
:location/country {:allowed-for #{:location/country}}
;; date range types -- these match a range of dates
:date/range {:type :date, :allowed-for #{:date/range :date/all-options}}
:date/month-year {:type :date, :allowed-for #{:date/month-year :date/all-options}}
:date/quarter-year {:type :date, :allowed-for #{:date/quarter-year :date/all-options}}
:date/relative {:type :date, :allowed-for #{:date/relative :date/all-options}}
;; Like `:id` and `:category` above, `:date/all-options` is primarily a widget type. It means that we should allow
;; any date option above.
:date/all-options {:type :date, :allowed-for #{:date/all-options}}
;; "operator" parameter types.
:number/!= {:type :numeric, :operator :variadic, :allowed-for #{:number/!=}}
:number/<= {:type :numeric, :operator :unary, :allowed-for #{:number/<=}}
:number/= {:type :numeric, :operator :variadic, :allowed-for #{:number/= :number :id :category
:location/zip_code}}
:number/>= {:type :numeric, :operator :unary, :allowed-for #{:number/>=}}
:number/between {:type :numeric, :operator :binary, :allowed-for #{:number/between}}
:string/!= {:type :string, :operator :variadic, :allowed-for #{:string/!=}}
:string/= {:type :string, :operator :variadic, :allowed-for #{:string/= :text :id :category
:location/city :location/state
:location/zip_code :location/country}}
:string/contains {:type :string, :operator :unary, :allowed-for #{:string/contains}}
:string/does-not-contain {:type :string, :operator :unary, :allowed-for #{:string/does-not-contain}}
:string/ends-with {:type :string, :operator :unary, :allowed-for #{:string/ends-with}}
:string/starts-with {:type :string, :operator :unary, :allowed-for #{:string/starts-with}}}) |
(mr/def ::ParameterType
(into [:enum {:error/message "valid parameter type"}] (keys parameter-types))) | |
(mr/def ::WidgetType
(into [:enum {:error/message "valid template tag widget type"} :none] (keys parameter-types))) | |
the next few clauses are used for parameter examples: {:target [:dimension [:template-tag "my_tag"]]} {:target [:dimension [:template-tag {:id "mytagid"}]]} {:target [:variable [:template-tag "another_tag"]]} {:target [:variable [:template-tag {:id "anothertagid"}]]} {:target [:dimension [:field 100 nil]]} {:target [:field 100 nil]} I'm not 100% clear on which situations we'll get which version. But I think the following is generally true:
One more thing to note: apparently | |
this is the reference like [:template-tag | (defclause template-tag
tag-name [:or
NonBlankString
[:map
[:id NonBlankString]]]) |
(defclause dimension target [:or Field template-tag]) | |
(defclause variable target template-tag) | |
Schema for the value of | (def ^:private ParameterTarget ;; not 100% sure about this but `field` on its own comes from a Dashboard parameter and when it's wrapped in ;; `dimension` it comes from a Field filter template tag parameter (don't quote me on this -- working theory) [:or Field (one-of dimension variable)]) |
Schema for the value of a parameter (e.g. a Dashboard parameter or a native query template tag) as passed in as
part of the | (def Parameter
[:map
[:type ParameterType]
;; TODO -- these definitely SHOULD NOT be optional but a ton of tests aren't passing them in like they should be.
;; At some point we need to go fix those tests and then make these keys required
[:id {:optional true} NonBlankString]
[:target {:optional true} ParameterTarget]
;; not specified if the param has no value. TODO - make this stricter; type of `:value` should be validated based
;; on the [[ParameterType]]
[:value {:optional true} :any]
;; the name of the parameter we're trying to set -- this is actually required now I think, or at least needs to get
;; merged in appropriately
[:name {:optional true} NonBlankString]
;; The following are not used by the code in this namespace but may or may not be specified depending on what the
;; code that constructs the query params is doing. We can go ahead and ignore these when present.
[:slug {:optional true} NonBlankString]
[:default {:optional true} :any]
[:required {:optional true} :any]]) |
Schema for a list of | (def ParameterList [:maybe [:sequential Parameter]]) |
---------------------------------------------------- Options ----------------------------------------------------- | |
Options that tweak the behavior of the query processor. | (def ^:private Settings
[:map
;; The timezone the query should be ran in, overriding the default report timezone for the instance.
[:report-timezone {:optional true} TimezoneId]]) |
Additional constraints added to a query limiting the maximum number of rows that can be returned. Mostly useful
because native queries don't support the MBQL | (def ^:private Constraints
[:and
[:map
;; maximum number of results to allow for a query with aggregations. If `max-results-bare-rows` is unset, this
;; applies to all queries
[:max-results {:optional true} IntGreaterThanOrEqualToZero]
;; maximum number of results to allow for a query with no aggregations.
;; If set, this should be LOWER than `:max-results`
[:max-results-bare-rows {:optional true} IntGreaterThanOrEqualToZero]]
[:fn
{:error/message "max-results-bare-rows must be less or equal to than max-results"}
(fn [{:keys [max-results max-results-bare-rows]}]
(if-not (core/and max-results max-results-bare-rows)
true
(core/>= max-results max-results-bare-rows)))]]) |
Additional options that can be used to toggle middleware on or off. | (def ^:private MiddlewareOptions
[:map
;; should we skip adding results_metadata to query results after running the query? Used by
;; [[metabase.query-processor.middleware.results-metadata]]; default `false`
[:skip-results-metadata? {:optional true} :boolean]
;; should we skip converting datetime types to ISO-8601 strings with appropriate timezone when post-processing
;; results? Used by [[metabase.query-processor.middleware.format-rows]]; default `false`
[:format-rows? {:optional true} :boolean]
;; disable the MBQL->native middleware. If you do this, the query will not work at all, so there are no cases where
;; you should set this yourself. This is only used by the [[metabase.query-processor/preprocess]] function to get
;; the fully pre-processed query without attempting to convert it to native.
[:disable-mbql->native? {:optional true} :boolean]
;; Disable applying a default limit on the query results. Handled in the `add-default-limit` middleware.
;; If true, this will override the `:max-results` and `:max-results-bare-rows` values in [[Constraints]].
[:disable-max-results? {:optional true} :boolean]
;; Userland queries are ones ran as a result of an API call, Pulse, or the like. Special handling is done in the
;; `process-userland-query` middleware for such queries -- results are returned in a slightly different format, and
;; QueryExecution entries are normally saved, unless you pass `:no-save` as the option.
[:userland-query? {:optional true} [:maybe :boolean]]
;; Whether to add some default `max-results` and `max-results-bare-rows` constraints. By default, none are added,
;; although the functions that ultimately power most API endpoints tend to set this to `true`. See
;; `add-constraints` middleware for more details.
[:add-default-userland-constraints? {:optional true} [:maybe :boolean]]
;; Whether to process a question's visualization settings and include them in the result metadata so that they can
;; incorporated into an export. Used by `metabase.query-processor.middleware.visualization-settings`; default `false`.
[:process-viz-settings? {:optional true} [:maybe :boolean]]]) |
------------------------------------------------------ Info ------------------------------------------------------ | |
This stuff is used for informational purposes, primarily to record QueryExecution entries when a query is ran. Pass them along if applicable when writing code that creates queries, but when working on middleware and the like you can most likely ignore this stuff entirely. | |
Schema for | (def Context [:enum :action :ad-hoc :collection :map-tiles :pulse :dashboard :question :csv-download :xlsx-download :json-download :public-dashboard :public-question :embedded-dashboard :embedded-question :embedded-csv-download :embedded-xlsx-download :embedded-json-download]) |
(def ^:private Hash
#?(:clj bytes?
:cljs :any)) | |
Schema for query TODO - this schema is somewhat misleading because if you use a function like
| (def ^:private Info
[:map
;; These keys are nice to pass in if you're running queries on the backend and you know these values. They aren't
;; used for permissions checking or anything like that so don't try to be sneaky
[:context {:optional true} [:maybe Context]]
[:executed-by {:optional true} [:maybe PositiveInt]]
[:action-id {:optional true} [:maybe PositiveInt]]
[:card-id {:optional true} [:maybe CardID]]
[:card-name {:optional true} [:maybe NonBlankString]]
[:dashboard-id {:optional true} [:maybe PositiveInt]]
[:alias/escaped->original {:optional true} [:maybe [:map-of :any :any]]]
[:pulse-id {:optional true} [:maybe PositiveInt]]
;; Metadata for datasets when querying the dataset. This ensures that user edits to dataset metadata are blended in
;; with runtime computed metadata so that edits are saved.
[:metadata/dataset-metadata {:optional true} [:maybe [:sequential [:map-of :any :any]]]]
;; `:hash` gets added automatically by `process-query-and-save-execution!`, so don't try passing
;; these in yourself. In fact, I would like this a lot better if we could take these keys out of `:info` entirely
;; and have the code that saves QueryExceutions figure out their values when it goes to save them
[:query-hash {:optional true} [:maybe Hash]]]) |
--------------------------------------------- Metabase [Outer] Query --------------------------------------------- | |
The ID used to signify that a database is 'virtual' rather than physical. A fake integer ID is used so as to minimize the number of changes that need to be made on the frontend -- by using something that would otherwise be a legal ID, nothing need change there, and the frontend can query against this 'database' none the wiser. (This integer ID is negative which means it will never conflict with a real database ID.) This ID acts as a sort of flag. The relevant places in the middleware can check whether the DB we're querying is this 'virtual' database and take the appropriate actions. | (def saved-questions-virtual-database-id lib.schema.id/saved-questions-virtual-database-id) |
To the reader: yes, this seems sort of hacky, but one of the goals of the Nested Query Initiative™ was to minimize if not completely eliminate any changes to the frontend. After experimenting with several possible ways to do this implementation seemed simplest and best met the goal. Luckily this is the only place this "magic number" is defined and the entire frontend can remain blissfully unaware of its value. | |
Schema for a valid | (def DatabaseID
[:or
{:error/message "valid Database ID"}
[:ref ::lib.schema.id/saved-questions-virtual-database]
[:ref ::lib.schema.id/database]]) |
Make sure we have the combo of query | (defn- check-keys-for-query-type
[schema]
[:and
schema
[:fn
{:error/message "Query must specify either `:native` or `:query`, but not both."}
(every-pred
(some-fn :native :query)
(complement (every-pred :native :query)))]
[:fn
{:error/message "Native queries must specify `:native`; MBQL queries must specify `:query`."}
(fn [{native :native, mbql :query, query-type :type}]
(core/case query-type
:native native
:query mbql))]]) |
Where this is added was changed in Metabase 0.33.0 -- previously, when This should automatically be fixed by | (defn- check-query-does-not-have-source-metadata
[schema]
[:and
schema
[:fn
{:error/message "`:source-metadata` should be added in the same level as `:source-query` (i.e., the 'inner' MBQL query.)"}
(complement :source-metadata)]]) |
Schema for an [outer] query, e.g. the sort of thing you'd pass to the query processor or save in
| (def Query [:ref ::Query]) |
(mr/def ::Query
(-> [:map
[:database DatabaseID]
;; Type of query. `:query` = MBQL; `:native` = native. TODO - consider normalizing `:query` to `:mbql`
[:type [:enum :query :native]]
[:native {:optional true} NativeQuery]
[:query {:optional true} MBQLQuery]
[:parameters {:optional true} ParameterList]
;;
;; OPTIONS
;;
;; These keys are used to tweak behavior of the Query Processor.
;; TODO - can we combine these all into a single `:options` map?
;;
[:settings {:optional true} [:maybe Settings]]
[:constraints {:optional true} [:maybe Constraints]]
[:middleware {:optional true} [:maybe MiddlewareOptions]]
;;
;; INFO
;;
;; Used when recording info about this run in the QueryExecution log; things like context query was ran in and
;; User who ran it
[:info {:optional true} [:maybe Info]]]
;;
;; CONSTRAINTS
check-keys-for-query-type
check-query-does-not-have-source-metadata)) | |
Is this a valid outer query? (Pre-compling a validator is more efficient.) | (def ^{:arglists '([query])} valid-query?
(mr/validator Query)) |
Validator for an outer query; throw an Exception explaining why the query is invalid if it is. | (def ^{:arglists '([query])} validate-query
(let [explainer (mr/explainer Query)]
(fn [query]
(if (valid-query? query)
query
(let [error (explainer query)
humanized (me/humanize error)]
(throw (ex-info (i18n/tru "Invalid query: {0}" (pr-str humanized))
{:error humanized
:original error}))))))) |
(ns metabase.mbql.schema.helpers (:refer-clojure :exclude [distinct]) (:require [clojure.string :as str] [metabase.types] [metabase.util.malli.registry :as mr])) | |
(comment metabase.types/keep-me) | |
--------------------------------------------------- defclause ---------------------------------------------------- | |
(defn- wrap-clause-arg-schema [arg-schema]
[:schema (if (qualified-keyword? arg-schema)
[:ref arg-schema]
arg-schema)]) | |
(defn- clause-arg-schema [arg-schema]
;; for things like optional schemas
(if-not (vector? arg-schema)
(wrap-clause-arg-schema arg-schema)
(let [[option arg-schema :as vector-arg-schema] arg-schema]
(case option
:optional [:? [:maybe (wrap-clause-arg-schema arg-schema)]]
:rest [:* (wrap-clause-arg-schema arg-schema)]
(wrap-clause-arg-schema vector-arg-schema))))) | |
If (is-clause? :count [:count 10]) ; -> true (is-clause? #{:+ :- :* :/} [:+ 10 20]) ; -> true TODO - this is a copy of the one in the [[metabase.mbql.util]] namespace. We need to reorganize things a bit so we can use the same fn and avoid circular refs | (defn is-clause?
[k-or-ks x]
(and
(vector? x)
(keyword? (first x))
(if (coll? k-or-ks)
((set k-or-ks) (first x))
(= k-or-ks (first x))))) |
Impl of [[metabase.mbql.schema.macros/defclause]] macro. Creates a Malli schema. | (defn clause
[tag & arg-schemas]
[:and
[:fn
{:error/message (str "not a " tag " clause")}
(partial is-clause? tag)]
(into
[:catn
["tag" [:= tag]]]
(for [[arg-name arg-schema] (partition 2 arg-schemas)]
[arg-name (clause-arg-schema arg-schema)]))]) |
(defn- clause-tag [clause]
(when (and (vector? clause)
(keyword? (first clause)))
(first clause))) | |
Interal impl of | (defn one-of*
[& tags+schemas]
(into
[:multi {:dispatch clause-tag
:error/message (str "valid instance of one of these MBQL clauses: " (str/join ", " (map first tags+schemas)))}]
(for [[tag schema] tags+schemas]
[tag (if (qualified-keyword? schema)
[:ref schema]
schema)]))) |
Schema for any keyword or string. | (def KeywordOrString [:or :keyword :string]) |
Add an addditonal constraint to | (defn non-empty
[schema]
(if (and (sequential? schema)
(= (first schema) :sequential))
(let [[_sequential & args] schema
[options & args] (if (map? (first args))
args
(cons nil args))]
(into [:sequential (assoc options :min 1)] args))
[:and
schema
[:fn
{:error/message "non-empty"}
seq]])) |
True if | (defn empty-or-distinct?
[coll]
(if (seq coll)
(apply distinct? coll)
true)) |
(mr/def ::distinct
[:fn
{:error/message "distinct"}
empty-or-distinct?]) | |
Add an additional constraint to | (defn distinct [schema] [:and schema [:ref ::distinct]]) |
(ns metabase.mbql.schema.macros (:require [metabase.mbql.schema.helpers :as metabase.mbql.schema.helpers] [metabase.util.malli.registry :as mr])) | |
(defn- stringify-names [arg-names-and-schemas]
(into []
(comp (partition-all 2)
(mapcat (fn [[arg-name schema]]
[(name arg-name) (if (and (list? schema)
(#{:optional :rest} (keyword (first schema))))
(vec (cons (keyword (first schema)) (rest schema)))
schema)])))
arg-names-and-schemas)) | |
Define a new MBQL clause. (defclause field-id, id su/IntGreaterThanZero) The first arg is the name of the clause, and should be followed by pairs of arg name, arg schema. Arg schemas may
optionally be wrapped in (defclause count, field (optional Field)) (defclause and, filters (rest Filter)) Since there are some cases where clauses should be parsed differently in MBQL (such as expressions in the
(defclause [ag:+ +] ...) ; define symbol | (defmacro defclause
[clause-name & arg-names-and-schemas]
(let [[symb-name clause-name] (if (vector? clause-name)
clause-name
[clause-name (or (:clause-name (meta clause-name)) clause-name)])
clause-registry-name (keyword "metabase.mbql.schema" (name symb-name))]
`(do
(mr/register! ~clause-registry-name
(metabase.mbql.schema.helpers/clause ~(keyword clause-name) ~@(stringify-names arg-names-and-schemas)))
(def ~(vary-meta symb-name assoc
:clause-name (keyword clause-name)
:clause-form (into [(keyword clause-name)]
(mapcat (fn [[arg schema]]
[(keyword arg) `'~schema])
(partition 2 arg-names-and-schemas)))
:doc (format "Schema for a valid %s clause." clause-name))
[:ref ~clause-registry-name])))) |
Define a schema that accepts one of several different MBQL clauses. (one-of field-id field-literal) | (defmacro one-of
[& clauses]
`(metabase.mbql.schema.helpers/one-of*
~@(for [clause clauses]
[`(or (:clause-name (meta (resolve '~clause)))
'~clause)
clause]))) |
(ns metabase.mbql.schema.macros (:require-macros [metabase.mbql.schema.macros])) | |
(comment metabase.mbql.schema.macros/keep-me) | |
(ns metabase.mbql.util.match (:refer-clojure :exclude [replace]) (:require [clojure.core.match] [metabase.mbql.util.match.impl]) (:require-macros [metabase.mbql.util.match])) | |
(comment clojure.core.match/keep-me
metabase.mbql.util.match/keep-me
metabase.mbql.util.match.impl/keep-me) | |
Internal implementation of the MBQL | (ns metabase.mbql.util.match (:refer-clojure :exclude [replace]) (:require [clojure.core.match] [clojure.walk :as walk] [metabase.mbql.util.match.impl :as metabase.mbql.util.match.impl] [net.cgrand.macrovich :as macros])) |
Generate a single approprate pattern for use with core.match based on the | (defn- generate-pattern
[pattern]
(cond
(keyword? pattern)
[[pattern '& '_]]
(and (set? pattern) (every? keyword? pattern))
[[`(:or ~@pattern) '& '_]]
;; special case for `_`, we'll let you match anything with that
(= pattern '_)
[pattern]
(symbol? pattern)
`[(~'_ :guard (metabase.mbql.util.match.impl/match-with-pred-or-class ~pattern))]
:else
[pattern])) |
(defn- recur-form? [form]
(and (seq? form)
(= 'recur (first form)))) | |
Replace any | (defn- rewrite-recurs
[fn-name result-form]
(walk/postwalk
(fn [form]
(if (recur-form? form)
;; we *could* use plain `recur` here, but `core.match` cannot apply code size optimizations if a `recur` form
;; is present. Instead, just do a non-tail-call-optimized call to the pattern fn so `core.match` can generate
;; efficient code.
;;
;; (recur [:new-clause ...]) ; -> (match-123456 &parents [:new-clause ...])
`(~fn-name ~'&parents ~@(rest form))
form))
result-form)) |
Generate the
| (defn- generate-patterns-and-results
[fn-name patterns-and-results & {:keys [wrap-result-forms?]}]
(mapcat (fn [[pattern result]]
[(generate-pattern pattern) (let [result (rewrite-recurs fn-name result)]
(if (or (not wrap-result-forms?)
(and (seq? result)
(= fn-name (first result))))
result
[result]))])
(partition 2 2 ['&match] patterns-and-results))) |
If the last pattern passed in was | (defn- skip-else-clause? ;; TODO - why don't we just let people pass their own `:else` clause instead? [patterns-and-results] (= '_ (second (reverse patterns-and-results)))) |
(defmethod clojure.core.match/emit-pattern-for-syntax [:isa? :default]
[[_ parent]] {:clojure.core.match/tag ::isa? :parent parent}) | |
(defmethod clojure.core.match/to-source ::isa?
[{parent :parent} ocr]
`(isa? ~ocr ~parent)) | |
Internal impl for | (defmacro match**
[& args]
(macros/case
:clj `(clojure.core.match/match ~@args)
:cljs `(cljs.core.match/match ~@args))) |
Internal impl for | (defmacro match*
[form patterns-and-results]
(let [match-fn-symb (gensym "match-")]
`(seq
(filter
some?
((fn ~match-fn-symb [~'&parents ~'&match]
(match** [~'&match]
~@(generate-patterns-and-results match-fn-symb patterns-and-results, :wrap-result-forms? true)
~@(when-not (skip-else-clause? patterns-and-results)
[:else `(metabase.mbql.util.match.impl/match-in-collection ~match-fn-symb ~'&parents ~'&match)])))
[]
~form))))) |
Return a sequence of things that match a
Examples: ;; keyword pattern (match {:fields [[:field 10 nil]]} :field) ; -> [[:field 10 nil]] ;; set of keywords (match some-query #{:field :expression}) ; -> [[:field 10 nil], [:expression "wow"], ...] ;; ;; symbol naming a Class ;; match anything that is an instance of that class (match some-query java.util.Date) ; -> [[#inst "2018-10-08", ...] ;; symbol naming a predicate function ;; match anything that satisfies that predicate (match some-query (every-pred integer? even?)) ; -> [2 4 6 8] ;; match anything with Using `core.match` patternsSee Pattern-matching works almost exactly the way it does when using
Returing something other than the exact match with result bodyBy default, ;; just return the IDs of Field ID clauses (match some-query [:field (id :guard integer?) _] id) ; -> [1 2 3] You can also use result body to filter results; any (match some-query [:field (id :guard integer?) _] (when (even? id) id)) ;; -> [2 4 6 8] Of course, it's more efficient to let You can also call `&match` and `&parents` anaphorsFor more advanced matches, like finding a (mbql.u/match {:filter [:time-interval [:field 1 nil] :current :month]} :field ;; &parents will be [:filter :time-interval] (when (contains? (set &parents) :time-interval) &match)) ;; -> [[:field 1 nil]] | (defmacro match
{:style/indent 1}
[x & patterns-and-results]
;; Actual implementation of these macros is in `mbql.util.match`. They're in a seperate namespace because they have
;; lots of other functions and macros they use for their implementation (which means they have to be public) that we
;; would like to discourage you from using directly.
`(match* ~x ~patterns-and-results)) |
Like | (defmacro match-one
{:style/indent 1}
[x & patterns-and-results]
`(first (match* ~x ~patterns-and-results))) |
TODO - it would be ultra handy to have a {:query {:source-table 1, :joins [{:source-table 2, ...}]}} it would be useful to be able to do ;; get all the source tables (mbql.u/match-all query (&match :guard (every-pred map? :source-table)) (:source-table &match)) | |
Internal implementation for | (defmacro replace*
[form patterns-and-results]
(let [replace-fn-symb (gensym "replace-")]
`((fn ~replace-fn-symb [~'&parents ~'&match]
(match** [~'&match]
~@(generate-patterns-and-results replace-fn-symb patterns-and-results, :wrap-result-forms? false)
~@(when-not (skip-else-clause? patterns-and-results)
[:else `(metabase.mbql.util.match.impl/replace-in-collection ~replace-fn-symb ~'&parents ~'&match)])))
[]
~form))) |
Like | (defmacro replace
{:style/indent 1}
[x & patterns-and-results]
;; as with `match` actual impl is in `match` namespace to discourage you from using the constituent functions and
;; macros that power this macro directly
`(replace* ~x ~patterns-and-results)) |
Like | (defmacro replace-in
{:style/indent 2}
[x ks & patterns-and-results]
`(metabase.mbql.util.match.impl/update-in-unless-empty ~x ~ks (fn [x#] (replace* x# ~patterns-and-results)))) |
TODO - it would be useful to have something like a | |
Internal implementation of the MBQL | (ns metabase.mbql.util.match.impl) |
Return a function to use for pattern matching via (Class-based matching currently only works in Clojure. For ClojureScript, only predicate function matching works.) have to do this at runtime because we don't know if a symbol is a class or pred or whatever when we compile the macro | (defn match-with-pred-or-class
[pred-or-class]
(cond
;; TODO -- FIXME -- Figure out how to make this work in JS
#?@(:clj [(class? pred-or-class)
(partial instance? pred-or-class)])
(fn? pred-or-class)
pred-or-class
:else
;; this is dev-specific so we don't need to localize it
(throw (ex-info "Invalid pattern: don't know how to handle symbol." {:symbol pred-or-class})))) |
Internal impl for | (defn match-in-collection
[match-fn clause-parents form]
{:pre [(fn? match-fn) (vector? clause-parents)]}
(cond
(map? form)
(mapcat (fn [[k v]]
(match-fn (conj clause-parents k) v))
form)
(sequential? form)
(mapcat (partial match-fn (if (keyword? (first form))
(conj clause-parents (first form))
clause-parents))
form))) |
Inernal impl for | (defn replace-in-collection
[replace-fn clause-parents form]
(cond
(map? form)
(into form (for [[k v] form]
[k (replace-fn (conj clause-parents k) v)]))
(sequential? form)
(mapv (partial replace-fn (if (keyword? (first form))
(conj clause-parents (first form))
clause-parents))
form)
:else form)) |
Like | (defn update-in-unless-empty
[m ks f & args]
(if-not (seq (get-in m ks))
m
(apply update-in m ks f args))) |
The core metabot namespace. Consists primarily of functions named infer-X, where X is the thing we want to extract from the bot response. | (ns metabase.metabot (:require [cheshire.core :as json] [metabase.lib.native :as lib-native] [metabase.metabot.client :as metabot-client] [metabase.metabot.settings :as metabot-settings] [metabase.metabot.util :as metabot-util] [metabase.models :refer [Table]] [metabase.util.log :as log] [toucan2.core :as t2])) |
Determine an 'interesting' visualization for this data. | (defn infer-viz
[{sql :sql :as context}]
(log/infof "Metabot is inferring visualization for sql '%s'." sql)
(if (metabot-settings/is-metabot-enabled)
(if (metabot-util/select-all? sql)
;; A SELECT * query just short-circuits to a tabular display
{:template {:display :table
:visualization_settings {}}}
;; More interesting SQL merits a more interesting display
(let [{:keys [prompt_template version] :as prompt} (metabot-util/create-prompt context)]
{:template (metabot-util/find-result
(fn [message]
(metabot-util/response->viz
(json/parse-string message keyword)))
(metabot-client/invoke-metabot prompt))
:prompt_template_version (format "%s:%s" prompt_template version)}))
(log/warn "Metabot is not enabled"))) |
Given a model and prompt, attempt to generate a native dataset. | (defn infer-sql
[{:keys [model user_prompt] :as context}]
(log/infof "Metabot is inferring sql for model '%s' with prompt '%s'." (:id model) user_prompt)
(if (metabot-settings/is-metabot-enabled)
(let [{:keys [prompt_template version] :as prompt} (metabot-util/create-prompt context)
{:keys [database_id inner_query]} model]
(if-some [bot-sql (metabot-util/find-result
metabot-util/extract-sql
(metabot-client/invoke-metabot prompt))]
(let [final-sql (metabot-util/bot-sql->final-sql model bot-sql)
_ (log/infof "Inferred sql for model '%s' with prompt '%s':\n%s"
(:id model)
user_prompt
final-sql)
template-tags (lib-native/extract-template-tags inner_query)
dataset {:dataset_query {:database database_id
:type "native"
:native {:query final-sql
:template-tags template-tags}}
:display :table
:visualization_settings {}}]
{:card dataset
:prompt_template_versions (vec
(conj
(:prompt_template_versions model)
(format "%s:%s" prompt_template version)))
:bot-sql bot-sql})
(log/infof "No sql inferred for model '%s' with prompt '%s'." (:id model) user_prompt)))
(log/warn "Metabot is not enabled"))) |
Find the model in the db that best matches the prompt using embedding matching. | (defn match-best-model
[{{database-id :id :keys [models]} :database :keys [user_prompt]}]
(log/infof "Metabot is inferring model for database '%s' with prompt '%s'." database-id user_prompt)
(if (metabot-settings/is-metabot-enabled)
(let [models (->> models
(map (fn [{:keys [create_table_ddl] :as model}]
(let [{:keys [prompt embedding tokens]} (metabot-client/create-embedding create_table_ddl)]
(assoc model
:prompt prompt
:embedding embedding
:tokens tokens)))))]
(if-some [{best-mode-name :name
best-model-id :id
:as model} (metabot-util/best-prompt-object models user_prompt)]
(do
(log/infof "Metabot selected best model for database '%s' with prompt '%s' as '%s' (%s)."
database-id user_prompt best-model-id best-mode-name)
model)
(log/infof "No model inferred for database '%s' with prompt '%s'." database-id user_prompt)))
(log/warn "Metabot is not enabled"))) |
Find the model in the db that best matches the prompt. Return nil if no good model found. | (defn infer-model
[{{database-id :id :keys [models]} :database :keys [user_prompt] :as context}]
(log/infof "Metabot is inferring model for database '%s' with prompt '%s'." database-id user_prompt)
(if (metabot-settings/is-metabot-enabled)
(let [{:keys [prompt_template version] :as prompt} (metabot-util/create-prompt context)
ids->models (zipmap (map :id models) models)
candidates (set (keys ids->models))
best-model-id (metabot-util/find-result
(fn [message]
(some->> message
(re-seq #"\d+")
(map parse-long)
(some candidates)))
(metabot-client/invoke-metabot prompt))]
(if-some [model (ids->models best-model-id)]
(do
(log/infof "Metabot selected best model for database '%s' with prompt '%s' as '%s'."
database-id user_prompt best-model-id)
(update model
:prompt_template_versions
(fnil conj [])
(format "%s:%s" prompt_template version)))
(log/infof "No model inferred for database '%s' with prompt '%s'." database-id user_prompt)))
(log/warn "Metabot is not enabled"))) |
Given a database and user prompt, determine a sql query to answer my question. | (defn infer-native-sql-query
[{{database-id :id} :database
:keys [user_prompt prompt_template_versions] :as context}]
(log/infof "Metabot is inferring sql for database '%s' with prompt '%s'." database-id user_prompt)
(if (metabot-settings/is-metabot-enabled)
(let [prompt-objects (->> (t2/select [Table :name :schema :id] :db_id database-id)
(map metabot-util/memoized-create-table-embedding)
(filter identity))
ddl (metabot-util/generate-prompt prompt-objects user_prompt)
context (assoc-in context [:database :create_database_ddl] ddl)
{:keys [prompt_template version] :as prompt} (metabot-util/create-prompt context)]
(if-some [sql (metabot-util/find-result
metabot-util/extract-sql
(metabot-client/invoke-metabot prompt))]
{:sql sql
:prompt_template_versions (conj
(vec prompt_template_versions)
(format "%s:%s" prompt_template version))}
(log/infof "No sql inferred for database '%s' with prompt '%s'." database-id user_prompt)))
(log/warn "Metabot is not enabled"))) |
(ns metabase.metabot.client (:require [cheshire.core :as json] [metabase.metabot.settings :as metabot-settings] [metabase.util.log :as log] [wkok.openai-clojure.api :as openai.api])) | |
(set! *warn-on-reflection* true) | |
Wrap our openai calls with a standard set of exceptions that will percolate up any issues to the UI as meaningful error messages. | (defn- wrap-openai-exceptions
[openai-fn]
(fn openai-call [params options]
(try
(openai-fn params options)
(catch Exception e
(log/warnf "Exception when calling invoke-metabot: %s" (.getMessage e))
(throw
;; If we have ex-data, we'll assume were intercepting an openai.api/create-chat-completion response
(if-some [status (:status (ex-data e))]
(let [{:keys [body]} (ex-data e)
{:keys [error]} (json/parse-string body keyword)
{error-type :type :keys [message code]} error]
(case (int status)
400 (do
(log/warnf "%s: %s" code message)
(ex-info
message
{:message message
:status-code 400}))
401 (ex-info
"Bot credentials are incorrect or not set.\nCheck with your administrator that the correct API keys are set."
{:message "Bot credentials are incorrect or not set.\nCheck with your administrator that the correct API keys are set."
;; Don't actually produce a 401 because you'll get redirect do the home page.
:status-code 400})
429 (if (= error-type "insufficient_quota")
(ex-info
"You exceeded your current OpenAI billing quota, please check your OpenAI plan and billing details."
{:message "You exceeded your current OpenAI billing quota, please check your OpenAI plan and billing details."
:status-code status})
(ex-info
"The bot server is under heavy load and cannot process your request at this time.\nPlease try again."
{:message "The bot server is under heavy load and cannot process your request at this time.\nPlease try again."
:status-code status}))
;; Just re-throw it until we get a better handle on
(ex-info
"Error calling remote bot server.\nPlease try again."
{:message "The bot server is under heavy load and cannot process your request at this time.\nPlease try again."
:status-code 500})))
;; If there's no ex-data, we'll assume it's some other issue and generate a 400
(ex-info
(ex-message e)
{:exception-data (ex-data e)
:status-code 400}))))))) |
OpenAI is the default completion endpoint | (defn- default-chat-completion-endpoint [params options] (openai.api/create-chat-completion (select-keys params [:model :n :messages]) options)) |
The endpoint used to invoke the remote LLM | (def ^:dynamic ^{:arglists '([params options])}
*create-chat-completion-endpoint*
default-chat-completion-endpoint) |
Call the bot and return the response. Takes messages to be used as instructions and a function that will find the first valid result from the messages. | (defn invoke-metabot
[{:keys [messages] :as prompt}]
{:pre [messages]}
((wrap-openai-exceptions *create-chat-completion-endpoint*)
(merge
{:model (metabot-settings/openai-model)
:n (metabot-settings/num-metabot-choices)}
prompt)
{:api-key (metabot-settings/openai-api-key)
:organization (metabot-settings/openai-organization)})) |
OpenAI is the default completion endpoint" | (defn- default-embedding-endpoint [params options] (log/debugf "Creating embedding...") (openai.api/create-embedding (select-keys params [:model :input]) options)) |
Default embeddings endpoint is both dynamic and memoized. | (def ^:dynamic ^{:arglists '([params options])}
*create-embedding-endpoint*
default-embedding-endpoint) |
Create an embedding vector from the given prompt. This response with the original prompt, the embedding vector, and the token count of the embeddings. The token count can be used to provide best fit queries for prompts requiring large amounts of data. | (defn create-embedding
([model prompt]
(let [{[{:keys [embedding]}] :data
{:keys [prompt_tokens]} :usage} ((wrap-openai-exceptions *create-embedding-endpoint*)
{:model model
:input prompt}
{:api-key (metabot-settings/openai-api-key)
:organization (metabot-settings/openai-organization)})]
{:prompt prompt
:embedding embedding
:tokens prompt_tokens}))
([prompt]
(create-embedding (metabot-settings/metabot-default-embedding-model) prompt))) |
(ns metabase.metabot.feedback
(:require [cheshire.core :as json]
[clj-http.client :as http]
[metabase.analytics.snowplow :as snowplow]
[metabase.api.common :as api]
[metabase.metabot.settings :as metabot-settings])) | |
(def ^:private snowplow-keys [:entity_type :prompt_template_versions :feedback_type]) (def ^:private feedback-keys (into snowplow-keys [:prompt :sql])) | |
Store feedback details, including the original prompt and generated sql. | (defn- store-detailed-feedback
[feedback]
(let [feedback (select-keys feedback feedback-keys)
{:keys [status body]} (http/request
{:url (metabot-settings/metabot-feedback-url)
:method :post
:body (json/generate-string
feedback
{:pretty true})
:throw-exceptions false
:as :json
:accept :json
:content-type :json})]
(when (= 200 status) body))) |
Store user-generated feedback as both a concise value in snowplow and more detailed values in a separate endpoint. | (defn submit-feedback
[feedback]
(let [snowplow-feedback (select-keys feedback snowplow-keys)]
(snowplow/track-event!
::snowplow/metabot-feedback-received api/*current-user-id*
snowplow-feedback)
(store-detailed-feedback feedback))) |
(ns metabase.metabot.settings (:require [clojure.core.memoize :as memoize] [metabase.models.setting :as setting :refer [defsetting]] [metabase.util :as u] [metabase.util.i18n :refer [deferred-tru]] [metabase.util.log :as log] [wkok.openai-clojure.api :as openai.api])) | |
(defsetting openai-model (deferred-tru "The OpenAI Model (e.g. 'gpt-4', 'gpt-3.5-turbo')") :visibility :settings-manager :default "gpt-4") | |
(defsetting openai-api-key (deferred-tru "The OpenAI API Key.") :visibility :settings-manager) | |
(defsetting openai-organization (deferred-tru "The OpenAI Organization ID.") :visibility :settings-manager) | |
(defsetting metabot-default-embedding-model (deferred-tru "The default embeddings model to be used for metabot.") :visibility :internal :default "text-embedding-ada-002") | |
(defsetting metabot-get-prompt-templates-url (deferred-tru "The URL in which metabot versioned prompt templates are stored.") :visibility :settings-manager :default "https://stkxezsr2kcnkhusi3fgcc5nqm0ttgfx.lambda-url.us-east-1.on.aws/") | |
(defsetting metabot-feedback-url (deferred-tru "The URL to which metabot feedback is posted.") :visibility :settings-manager :default "https://amtix3l3qvitb2qxstaqtcoqby0monuf.lambda-url.us-east-1.on.aws/") | |
(defsetting is-metabot-enabled
(deferred-tru "Is Metabot enabled?")
:type :boolean
:visibility :public
:getter (fn []
(boolean (setting/env-var-value :is-metabot-enabled)))
:default false) | |
(defsetting num-metabot-choices (deferred-tru "Number of potential responses metabot will request. The first valid response is selected.") :type :integer :visibility :internal :default 1) | |
Downselect the available openai models to only the latest version of each GPT family. | (defn- select-models
[models]
(->> models
(map (fn [{:keys [id] :as m}]
(when-some [[_ v r] (re-matches #"gpt-([\d\.]+)(.*)"
(u/lower-case-en id))]
(let [version (parse-double v)]
(assoc m
:version version
:version-string v
:generation (int version)
:details r)))))
;; Drop anything that doesn't match
(filter identity)
;; Order by generation (asc), version (desc),
;; length of details string (asc), length of version string (desc)
(sort-by (juxt :generation
(comp - :version)
(comp count :details)
(comp - count :version-string)))
;; Split out each generation
(partition-by :generation)
;; Take the top item in each partition and select what we want
(map (comp #(select-keys % [:id :owned_by]) first))
reverse)) |
(def ^:private memoized-fetch-openai-models
(memoize/ttl
^{::memoize/args-fn (fn [[api-key organization]] [api-key organization])}
(fn [api-key organization]
(try
(->> (openai.api/list-models
{:api-key api-key
:organization organization})
:data
select-models)
(catch Exception _
(log/warn "Unable to fetch openai models.")
[])))
:ttl/threshold (* 1000 60 60 24))) | |
(defsetting openai-available-models
(deferred-tru "List available openai models.")
:visibility :settings-manager
:type :json
:setter :none
:getter (fn []
(if (and
(is-metabot-enabled)
(openai-api-key)
(openai-organization))
(memoized-fetch-openai-models
(openai-api-key)
(openai-organization))
[]))) | |
(defsetting enum-cardinality-threshold (deferred-tru "Enumerated field values with cardinality at or below this point are treated as enums in the pseudo-ddl used in some model prompts.") :type :integer :visibility :internal :default 60) | |
(defsetting metabot-prompt-generator-token-limit (deferred-tru "When attempting to assemble prompts, the threshold at which prompt will no longer be appended to.") :type :integer :visibility :internal :default 6000) | |
Functions for denormalizing input, prompt input generation, and sql handing. If this grows much, we might want to split these out into separate nses. | (ns metabase.metabot.util (:require [cheshire.core :as json] [clojure.core.memoize :as memoize] [clojure.string :as str] [honey.sql :as sql] [metabase.db.query :as mdb.query] [metabase.mbql.util :as mbql.u] [metabase.metabot.client :as metabot-client] [metabase.metabot.settings :as metabot-settings] [metabase.models :refer [Card Field FieldValues Table]] [metabase.query-processor :as qp] [metabase.query-processor.reducible :as qp.reducible] [metabase.query-processor.util.add-alias-info :as add] [metabase.util :as u] [metabase.util.log :as log] [toucan2.core :as t2])) |
Is metabot supported for the given database. | (defn supported?
[db-id]
(let [q "SELECT 1 FROM (SELECT 1 AS ONE) AS TEST"]
(try
(some?
(qp/process-query {:database db-id
:type "native"
:native {:query q}}))
(catch Exception _ false)))) |
Input Denormalization ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
Normalize model and column names to SLUG_CASE. The current bot responses do a terrible job of creating all kinds of SQL from a table or column name. Example: 'Created At', CREATED_AT, "created at" might all come back in the response. Standardization of names produces dramatically better results. | (defn normalize-name
[s]
(some-> s
u/upper-case-en
(str/replace #"[^\p{Alnum}]+" " ")
str/trim
(str/replace #" " "_"))) |
Add the aliases generated by the query processor to each results metadata field. | (defn- add-qp-column-aliases
[{:keys [dataset_query] :as model}]
(let [fields (let [qp (qp.reducible/combine-middleware
(vec qp/around-middleware)
(fn [query _rff _context]
(add/add-alias-info
(#'qp/preprocess* query))))]
(get-in (qp dataset_query nil nil) [:query :fields]))
field-ref->alias (reduce
(fn [acc [_f _id-or-name m :as field-ref]]
(if-let [alias (::add/desired-alias m)]
(assoc acc (mbql.u/remove-namespaced-options field-ref) alias)
acc))
{}
fields)]
(update model :result_metadata
(fn [result_metadata]
(map
(fn [{:keys [field_ref] :as rsmd}]
(assoc rsmd :qp_column_name (field-ref->alias field_ref)))
result_metadata))))) |
Produce a SELECT * over the parameterized model with columns aliased to normalized display names. Add this result to the input model along with the generated column aliases. This can be used in a CTE such that an outer query can be called on this query. | (defn- add-inner-query
[{:keys [id result_metadata] :as model}]
(let [column-aliases (or
(some->> result_metadata
(map (comp
(fn [[column_name column_alias]]
(cond
(and column_name column_alias) (format "\"%s\" AS %s" column_name column_alias)
column_alias column_alias
:else nil))
(juxt :qp_column_name :sql_name)))
(filter identity)
seq
(str/join ", "))
"*")]
(assoc model
:column_aliases column-aliases
:inner_query
(mdb.query/format-sql
(format "SELECT %s FROM {{#%s}} AS INNER_QUERY" column-aliases id))))) |
Create a 'denormalized' version of the field which is optimized for querying and prompt engineering. Add in enumerated values (if a low-cardinality field), and remove fields unused in prompt engineering. | (defn- denormalize-field
([{:keys [id base_type] :as field} enum-cardinality-threshold]
(let [field-vals (when
(and
(not= :type/Boolean base_type)
(< 0
(get-in field [:fingerprint :global :distinct-count] 0)
(inc enum-cardinality-threshold)))
(t2/select-one-fn :values FieldValues :field_id id))]
(-> (cond-> field
(seq field-vals)
(assoc :possible_values (vec field-vals)))
(dissoc :field_ref :id))))
([field]
(denormalize-field
field
(metabot-settings/enum-cardinality-threshold)))) |
Create the postgres enum for any item in result_metadata that has enumerated/low cardinality values. | (defn- model->enum-ddl
[{:keys [result_metadata]}]
(into {}
(for [{:keys [display_name sql_name possible_values]} result_metadata
:when (seq possible_values)
:let [ddl-str (format "create type %s_t as enum %s;"
sql_name
(str/join ", " (map (partial format "'%s'") possible_values)))
nchars (count ddl-str)]]
(do
(log/tracef "Pseudo-ddl for field '%s' enumerates %s possible values contains %s chars (~%s tokens)."
display_name
(count possible_values)
nchars
(quot nchars 4))
[sql_name ddl-str])))) |
Create an equivalent DDL for this model | (defn- model->pseudo-ddl
[{model-name :name model-id :id :keys [sql_name result_metadata] :as model}]
(log/debugf "Creating pseudo-ddl for model '%s'(%s):"
model-name
model-id)
(let [enums (model->enum-ddl model)
[ddl] (sql/format
{:create-table sql_name
:with-columns (for [{:keys [sql_name base_type]} result_metadata
:let [k sql_name]]
[k (if (enums k)
(format "%s_t" k)
base_type)])}
{:dialect :ansi})
ddl-str (str/join "\n\n" (conj (vec (vals enums)) (mdb.query/format-sql ddl)))
nchars (count ddl-str)]
(log/debugf "Pseudo-ddl for model '%s'(%s) describes %s enum fields and contains %s chars (~%s tokens)."
model-name
model-id
(count enums)
nchars
(quot nchars 4))
ddl-str)) |
(defn- add-create-table-ddl [model] (assoc model :create_table_ddl (model->pseudo-ddl model))) | |
Given a seq of names that are potentially the same, provide a seq of tuples of original name to a non-ambiguous version of the name. | (defn- disambiguate
[names]
(let [uniquifier (mbql.u/unique-name-generator)
[_ new-names] (reduce
(fn [[taken acc] n]
(let [candidate (uniquifier n)]
(if (taken candidate)
(recur [(conj taken candidate) acc] n)
[(conj taken candidate) (conj acc candidate)])))
[#{} []] names)]
(map vector names new-names))) |
Add a distinct SCREAMINGSNAKECASE sql name to each field in the result_metadata. | (defn- add-sql-names
[{:keys [result_metadata] :as model}]
(update model :result_metadata
#(->> %
(map (comp normalize-name :display_name))
disambiguate
(map (fn [rsmd [_ disambiguated-name]]
(assoc rsmd :sql_name disambiguated-name)) result_metadata)))) |
Create a 'denormalized' version of the model which is optimized for querying. All foreign keys are resolved as data, sql-friendly names are added, and an inner_query is added that is a 'plain sql' query of the data (with sql friendly column names) that can be used to query this model. | (defn denormalize-model
[{model-name :name :as model}]
(-> model
add-qp-column-aliases
add-sql-names
add-inner-query
(update :result_metadata #(mapv denormalize-field %))
(assoc :sql_name (normalize-name model-name))
add-create-table-ddl
(dissoc :creator_id :dataset_query :table_id :collection_position))) |
Convert a map of {:models ...} to a json string summary of these models. This is used as a summary of the database in prompt engineering. | (defn- models->json-summary
[{:keys [models]}]
(let [json-str (json/generate-string
{:tables
(for [{model-name :name model-id :id :keys [result_metadata] :as _model} models]
{:table-id model-id
:table-name model-name
:column-names (mapv :display_name result_metadata)})}
{:pretty true})
nchars (count json-str)]
(log/debugf "Database json string descriptor contains %s chars (~%s tokens)."
nchars
(quot nchars 4))
json-str)) |
(defn- add-model-json-summary [database] (assoc database :model_json_summary (models->json-summary database))) | |
For a field, create a potential enumerated type string. Returns nil if there are no field values or the cardinality is too high. | (defn- field->pseudo-enums
([{table-name :name} {field-name :name field-id :id :keys [base_type]} enum-cardinality-threshold]
(when-let [values (and
(not= :type/Boolean base_type)
(t2/select-one-fn :values FieldValues :field_id field-id))]
(when (<= (count values) enum-cardinality-threshold)
(let [ddl-str (format "create type %s_%s_t as enum %s;"
table-name
field-name
(str/join ", " (map (partial format "'%s'") values)))
nchars (count ddl-str)]
(log/debugf "Pseudo-ddl for field enum %s describes %s values and contains %s chars (~%s tokens)."
field-name
(count values)
nchars
(quot nchars 4))
ddl-str))))
([table field]
(field->pseudo-enums table field (metabot-settings/enum-cardinality-threshold)))) |
Create an 'approximate' ddl to represent how this table might be created as SQL. This can be very expensive if performed over an entire database, so memoization is recommended. Memoization currently happens in create-table-embedding. | (defn table->pseudo-ddl
([{table-name :name schema-name :schema table-id :id :as table} enum-cardinality-threshold]
(let [fields (t2/select [Field
:base_type
:database_required
:database_type
:fk_target_field_id
:id
:name
:semantic_type]
:table_id table-id)
enums (reduce
(fn [acc {field-name :name :as field}]
(if-some [enums (field->pseudo-enums table field enum-cardinality-threshold)]
(assoc acc field-name enums)
acc))
{}
fields)
columns (vec
(for [{column-name :name :keys [database_required database_type]} fields]
(cond-> [column-name
(if (enums column-name)
(format "%s_%s_t" table-name column-name)
database_type)]
database_required
(conj [:not nil]))))
primary-keys [[(into [:primary-key]
(comp (filter (comp #{:type/PK} :semantic_type))
(map :name))
fields)]]
foreign-keys (for [{field-name :name :keys [semantic_type fk_target_field_id]} fields
:when (= :type/FK semantic_type)
:let [{fk-field-name :name fk-table-id :table_id} (t2/select-one [Field :name :table_id]
:id fk_target_field_id)
{fk-table-name :name fk-table-schema :schema} (t2/select-one [Table :name :schema]
:id fk-table-id)]]
[[:foreign-key field-name]
[:references (cond->>
fk-table-name
fk-table-schema
(format "%s.%s" fk-table-schema))
fk-field-name]])
create-sql (->
(sql/format
{:create-table (keyword schema-name table-name)
:with-columns (reduce into columns [primary-keys foreign-keys])}
{:dialect :ansi :pretty true})
first
mdb.query/format-sql)
ddl-str (str/join "\n\n" (conj (vec (vals enums)) create-sql))
nchars (count ddl-str)]
(log/debugf "Pseudo-ddl for table '%s.%s'(%s) describes %s fields, %s enums, and contains %s chars (~%s tokens)."
schema-name
table-name
table-id
(count fields)
(count enums)
nchars
(quot nchars 4))
ddl-str))
([table]
(table->pseudo-ddl table (metabot-settings/enum-cardinality-threshold)))) |
Create a 'denormalized' version of the database which is optimized for querying. Adds in denormalized models, sql-friendly names, and a json summary of the models appropriate for prompt engineering. | (defn denormalize-database
[{database-name :name db_id :id :as database}]
(let [models (t2/select Card :database_id db_id :dataset true)]
(-> database
(assoc :sql_name (normalize-name database-name))
(assoc :models (mapv denormalize-model models))
add-model-json-summary))) |
Pseudo-ddls -> Embeddings ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
Given a table (and an optional threshold to downsize the generated table enums) will compute relevant embedding information: - prompt: The prompt encoded for the table (a pseudo create table ddl) - embedding: A vector of doubles that encodes the prompt for embedding comparison - tokens: The number of tokens used to encode the prompt This function will recursively try to create an embedding for the table pseudo-ddl starting with the default enum cardinality (distinct fields at or below this count are turned into DDL enums). If the creation fails, will try again with the enum threshold divided by 2 until either a result is generated or the operation fails (returning nil). Although returning nil (vs throwing) may mask the fact that a particular table isn't present in the final embeddings set, this allows for queries over the rest of the database, which is preferred. Anything so large (the table name, column names, and base column types have to exceed the token limit) is probably going to be problematic and a model would be a better fit anyways. | (defn create-table-embedding
([{table-name :name table-id :id :as table} enum-cardinality-threshold]
(log/debugf
"Creating embedding for table '%s'(%s) with cardinality threshold '%s'."
table-name
table-id
enum-cardinality-threshold)
(try
(let [ddl (table->pseudo-ddl table enum-cardinality-threshold)
{:keys [prompt embedding tokens]} (metabot-client/create-embedding ddl)]
{:prompt prompt
:embedding embedding
:tokens tokens})
;; The most likely case of throwing here is that the ddl is too big.
;; When this happens, we'll try again with 1/2 the cardinality selected.
;; This will reduce the number of fields that become enumerated.
;; In the extreme case (= enum-cardinality-threshold 0), no enums are created.
;; The only way this would fail to create an embedding would be if the number
;; of columns were so huge that just that list of columns and types exceeded
;; the embedding token limit.
(catch Exception e
(let [{:keys [status-code message]} (ex-data e)]
(if (and (pos? enum-cardinality-threshold)
(= 400 status-code))
(let [new-enum-cardinality-threshold (quot enum-cardinality-threshold 2)]
(log/debugf
(str
"Embedding creation for table '%s'(%s) with cardinality threshold '%s' failed. "
"Retrying again with cardinality threshold '%s'.")
table-name
table-id
enum-cardinality-threshold
new-enum-cardinality-threshold)
(create-table-embedding table new-enum-cardinality-threshold))
;; Instead of throwing an exception, we are going to try to recover and
; ignore the problematic table. This is likely a massive table with too
;; many columns and would be a better candidate for a model.
(log/warnf
(str/join
" "
["Embeddings for table '%s'(%s) could not be generated."
"It could be that this table has too many columns."
"You might want to create a model for this table instead."
"Error message: %s"])
table-name
table-id
message))))))
([table]
(create-table-embedding table (metabot-settings/enum-cardinality-threshold)))) |
Memoized version of create-table-embedding. Generally embeddings are small, so this is a reasonable tradeoff, especially when the number of tables in a db is large. Should probably have the same threshold as metabot-client/memoized-create-embedding. | (def memoized-create-table-embedding
(memoize/ttl
^{::memoize/args-fn (fn [[{table-id :id} enum-cardinality-threshold]]
[table-id enum-cardinality-threshold])}
create-table-embedding
;; 24-hour ttl
:ttl/threshold (* 1000 60 60 24))) |
Prompt Input ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
Given a prompt template and a context, fill the template messages in with the appropriate values to create the actual submitted messages. | (defn- prompt-template->messages
[{:keys [messages]} context]
(letfn [(update-contents [s]
(str/replace s #"%%([^%]+)%%"
(fn [[_ path]]
(let [kw (->> (str/split path #":")
(mapv (comp keyword u/lower-case-en)))]
(or (get-in context kw)
(let [message (format "No value found in context for key path '%s'" kw)]
(throw (ex-info
message
{:message message
:status-code 400}))))))))]
(map (fn [prompt] (update prompt :content update-contents)) messages))) |
Retrieve prompt templates from the metabot-get-prompt-templates-url. | (defn- default-prompt-templates
[]
(log/info "Refreshing metabot prompt templates.")
(let [all-templates (-> (metabot-settings/metabot-get-prompt-templates-url)
slurp
(json/parse-string keyword))]
(-> (group-by (comp keyword :prompt_template) all-templates)
(update-vals
(fn [templates]
(let [ordered (vec (sort-by :version templates))]
{:latest (peek ordered)
:templates ordered})))))) |
Return a map of prompt templates with keys of template type and values which are objects containing keys 'latest' (the latest template version) and 'templates' (all template versions). | (def ^:private ^:dynamic *prompt-templates*
(memoize/ttl
default-prompt-templates
;; Check for updates every hour
:ttl/threshold (* 1000 60 60))) |
Create a prompt by looking up the latest template for the prompt_task type of the context interpolating all values from the template. The returned value is the template object with the prompt contained in the ':prompt' key. | (defn create-prompt
[{:keys [prompt_task] :as context}]
(if-some [{:keys [messages] :as template} (get-in (*prompt-templates*) [prompt_task :latest])]
(let [prompt (assoc template
:message_templates messages
:messages (prompt-template->messages template context))]
(let [nchars (count (mapcat :content messages))]
(log/debugf "Prompt running with %s chars (~%s tokens)." nchars (quot nchars 4)))
prompt)
(throw
(ex-info
(format "No prompt inference template found for prompt type: %s" prompt_task)
{:prompt_type prompt_task})))) |
Results Processing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
Is this a simple SELECT * query? | (defn select-all? [sql] (some? (re-find #"(?i)^select\s*\*" sql))) |
Given a set of choices returned from the bot, find the first one returned by the supplied message-fn. | (defn find-result
[message-fn {:keys [choices]}]
(or
(some
(fn [{:keys [message]}]
(when-some [res (message-fn (:content message))]
res))
choices)
(log/infof
"Unable to find appropriate result for user prompt in responses:\n\t%s"
(str/join "\n\t" (map (fn [m] (get-in m [:message :content])) choices))))) |
Search a provided string for a SQL block | (defn extract-sql
[s]
(let [sql (if (str/starts-with? (u/upper-case-en (str/trim s)) "SELECT")
;; This is just a raw SQL statement
s
;; It looks like markdown
(let [[_pre sql _post] (str/split s #"```(sql|SQL)?")]
sql))]
(mdb.query/format-sql sql))) |
Produce the final query usable by the UI but converting the model to a CTE and calling the bot sql on top of it. | (defn bot-sql->final-sql
[{:keys [inner_query sql_name] :as _denormalized-model} outer-query]
(format "WITH %s AS (%s) %s" sql_name inner_query outer-query)) |
Given a response from the LLM, map this to visualization settings. Default to a table. | (defn response->viz
[{:keys [display description visualization_settings]}]
(let [display (keyword display)
{:keys [x-axis y-axis]} visualization_settings]
(case display
(:line :bar :area :waterfall) {:display display
:name description
:visualization_settings {:graph.dimensions [x-axis]
:graph.metrics y-axis}}
:scalar {:display display
:name description
:visualization_settings {:graph.metrics y-axis
:graph.dimensions []}}
{:display :table
:name description
:visualization_settings {:title description}}))) |
Embedding Selection ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
Given a set of 'prompt objects' (a seq of items with keys :embedding :tokens :prompt), and a prompt will add the :prompt and :prompt_match to each object. | (defn score-prompt-embeddings
[prompt-objects user-prompt]
(let [dot (fn dot [a b] (reduce + (map * a b)))
{prompt-embedding :embedding} (metabot-client/create-embedding user-prompt)]
(map
(fn [{:keys [embedding] :as prompt-object}]
(assoc prompt-object
:user_prompt user-prompt
:prompt_match (dot prompt-embedding embedding)))
prompt-objects))) |
Given a set of 'prompt objects' (a seq of items with keys :embedding :tokens :prompt), will determine the set of prompts that best match the given prompt whose token sum does not exceed the token limit. | (defn generate-prompt
([prompt-objects prompt token-limit]
(->> (score-prompt-embeddings prompt-objects prompt)
(sort-by (comp - :prompt_match))
(reduce
(fn [{:keys [total-tokens] :as acc} {:keys [prompt tokens]}]
(if (> (+ tokens total-tokens) token-limit)
(reduced acc)
(-> acc
(update :total-tokens + tokens)
(update :prompts conj prompt))))
{:total-tokens 0 :prompts []})
:prompts
(str/join "\n")))
([prompt-objects prompt]
(generate-prompt prompt-objects prompt (metabot-settings/metabot-prompt-generator-token-limit)))) |
Given a set of 'prompt objects' (a seq of items with keys :embedding :tokens :prompt), will return the item that best matches the input prompt. | (defn best-prompt-object
([prompt-objects prompt]
(some->> (score-prompt-embeddings prompt-objects prompt)
seq
(apply max-key :prompt_match)))) |
(ns metabase.models
(:require
[metabase.models.action :as action]
[metabase.models.activity :as activity]
[metabase.models.application-permissions-revision :as a-perm-revision]
[metabase.models.bookmark :as bookmark]
[metabase.models.card :as card]
[metabase.models.collection :as collection]
[metabase.models.collection-permission-graph-revision
:as c-perm-revision]
[metabase.models.dashboard :as dashboard]
[metabase.models.dashboard-card :as dashboard-card]
[metabase.models.dashboard-card-series :as dashboard-card-series]
[metabase.models.dashboard-tab :as dashboard-tab]
[metabase.models.database :as database]
[metabase.models.dimension :as dimension]
[metabase.models.field :as field]
[metabase.models.field-values :as field-values]
[metabase.models.login-history :as login-history]
[metabase.models.metric :as metric]
[metabase.models.metric-important-field :as metric-important-field]
[metabase.models.model-index :as model-index]
[metabase.models.moderation-review :as moderation-review]
[metabase.models.native-query-snippet :as native-query-snippet]
[metabase.models.parameter-card :as parameter-card]
[metabase.models.permissions :as perms]
[metabase.models.permissions-group :as perms-group]
[metabase.models.permissions-group-membership
:as perms-group-membership]
[metabase.models.permissions-revision :as perms-revision]
[metabase.models.persisted-info :as persisted-info]
[metabase.models.pulse :as pulse]
[metabase.models.pulse-card :as pulse-card]
[metabase.models.pulse-channel :as pulse-channel]
[metabase.models.pulse-channel-recipient :as pulse-channel-recipient]
[metabase.models.query-cache :as query-cache]
[metabase.models.query-execution :as query-execution]
[metabase.models.revision :as revision]
[metabase.models.secret :as secret]
[metabase.models.segment :as segment]
[metabase.models.session :as session]
[metabase.models.setting :as setting]
[metabase.models.table :as table]
[metabase.models.table-privileges]
[metabase.models.task-history :as task-history]
[metabase.models.timeline :as timeline]
[metabase.models.timeline-event :as timeline-event]
[metabase.models.user :as user]
[metabase.models.view-log :as view-log]
[metabase.plugins.classloader :as classloader]
[metabase.public-settings.premium-features :refer [defenterprise]]
[metabase.util :as u]
[methodical.core :as methodical]
[potemkin :as p]
[toucan2.model :as t2.model])) | |
Fool the linter | (comment action/keep-me
activity/keep-me
card/keep-me
bookmark/keep-me
collection/keep-me
c-perm-revision/keep-me
dashboard/keep-me
dashboard-card/keep-me
dashboard-card-series/keep-me
dashboard-tab/keep-me
database/keep-me
dimension/keep-me
field/keep-me
field-values/keep-me
a-perm-revision/keep-me
login-history/keep-me
metric/keep-me
moderation-review/keep-me
metric-important-field/keep-me
native-query-snippet/keep-me
parameter-card/keep-me
perms-group-membership/keep-me
perms-group/keep-me
perms-revision/keep-me
perms/keep-me
persisted-info/keep-me
pulse-card/keep-me
pulse-channel-recipient/keep-me
pulse-channel/keep-me
pulse/keep-me
query-cache/keep-me
query-execution/keep-me
revision/keep-me
secret/keep-me
segment/keep-me
session/keep-me
setting/keep-me
table/keep-me
task-history/keep-me
timeline-event/keep-me
timeline/keep-me
user/keep-me
view-log/keep-me) |
(p/import-vars [action Action HTTPAction ImplicitAction QueryAction] [activity Activity] [bookmark CardBookmark] [bookmark DashboardBookmark] [bookmark CollectionBookmark] [bookmark BookmarkOrdering] [card Card] [collection Collection] [c-perm-revision CollectionPermissionGraphRevision] [dashboard Dashboard] [dashboard-card DashboardCard] [dashboard-card-series DashboardCardSeries] [database Database] [dimension Dimension] [field Field] [field-values FieldValues] [login-history LoginHistory] [metric Metric] [moderation-review ModerationReview] [model-index ModelIndex ModelIndexValue] [metric-important-field MetricImportantField] [native-query-snippet NativeQuerySnippet] [parameter-card ParameterCard] [perms Permissions] [perms-group PermissionsGroup] [perms-group-membership PermissionsGroupMembership] [perms-revision PermissionsRevision] [a-perm-revision ApplicationPermissionsRevision] [persisted-info PersistedInfo] [pulse Pulse] [pulse-card PulseCard] [pulse-channel PulseChannel] [pulse-channel-recipient PulseChannelRecipient] [query-cache QueryCache] [query-execution QueryExecution] [revision Revision] [secret Secret] [segment Segment] [session Session] [setting Setting] [table Table] [task-history TaskHistory] [timeline Timeline] [timeline-event TimelineEvent] [user User] [view-log ViewLog]) | |
OSS version; no-op. | (defenterprise resolve-enterprise-model metabase-enterprise.models [x] x) |
(methodical/defmethod t2.model/resolve-model :before :default
"Ensure the namespace for given model is loaded.
This is a safety mechanism as we are moving to toucan2 and we don't need to require the model namespaces in order to use it."
[x]
(when (and (keyword? x)
(= (namespace x) "model")
;; Don't try to require if it's already registered as a :metabase/model, since that means it has already
;; been required
(not (isa? x :metabase/model)))
(try
(let [model-namespace (str "metabase.models." (u/->kebab-case-en (name x)))]
;; use `classloader/require` which is thread-safe and plays nice with our plugins system
(classloader/require model-namespace))
(catch clojure.lang.ExceptionInfo _
(resolve-enterprise-model x))))
x) | |
(methodical/defmethod t2.model/resolve-model :around clojure.lang.Symbol
"Handle models deriving from :metabase/model."
[symb]
(or
(when (simple-symbol? symb)
(let [metabase-models-keyword (keyword "model" (name symb))]
(when (isa? metabase-models-keyword :metabase/model)
metabase-models-keyword)))
(next-method symb))) | |
(ns metabase.models.action (:require [cheshire.core :as json] [medley.core :as m] [metabase.models.card :refer [Card]] [metabase.models.interface :as mi] [metabase.models.query :as query] [metabase.models.serialization :as serdes] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log] [methodical.core :as methodical] [toucan2.core :as t2])) | |
-------------------------------------------- Entity & Life Cycle ---------------------------------------------- | |
(methodical/defmethod t2/table-name :model/Action [_model] :action) (methodical/defmethod t2/table-name :model/QueryAction [_model] :query_action) (methodical/defmethod t2/table-name :model/HTTPAction [_model] :http_action) (methodical/defmethod t2/table-name :model/ImplicitAction [_model] :implicit_action) | |
Action model Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the Actions symbol in our codebase. QueryAction model HTTPAction model ImplicitAction model | (def Action :model/Action) (def QueryAction :model/QueryAction) (def HTTPAction :model/HTTPAction) (def ImplicitAction :model/ImplicitAction) |
(def ^:private action-sub-models [:model/QueryAction :model/HTTPAction :model/ImplicitAction]) | |
(doto :model/Action (derive :metabase/model) ;;; You can read/write an Action if you can read/write its model (Card) (derive ::mi/read-policy.full-perms-for-perms-set) (derive ::mi/write-policy.full-perms-for-perms-set) (derive :hook/entity-id) (derive :hook/timestamped?)) | |
(doseq [model action-sub-models] (derive model :metabase/model)) | |
(methodical/defmethod t2/primary-keys :model/QueryAction [_model] [:action_id]) (methodical/defmethod t2/primary-keys :model/HTTPAction [_model] [:action_id]) (methodical/defmethod t2/primary-keys :model/ImplicitAction [_model] [:action_id]) | |
(def ^:private transform-action-visualization-settings
{:in mi/json-in
:out (comp (fn [viz-settings]
;; the keys of :fields should be strings, not keywords
(m/update-existing viz-settings :fields update-keys name))
mi/json-out-with-keywordization)}) | |
(t2/deftransforms :model/Action
{:type mi/transform-keyword
:parameter_mappings mi/transform-parameters-list
:parameters mi/transform-parameters-list
:visualization_settings transform-action-visualization-settings}) | |
(t2/deftransforms :model/QueryAction
;; shouldn't this be mi/transform-metabase-query?
{:dataset_query mi/transform-json}) | |
(def ^:private transform-json-with-nested-parameters
{:in (comp mi/json-in
(fn [template]
(u/update-if-exists template :parameters mi/normalize-parameters-list)))
:out (comp (fn [template]
(u/update-if-exists template :parameters (mi/catch-normalization-exceptions mi/normalize-parameters-list)))
mi/json-out-with-keywordization)}) | |
(t2/deftransforms :model/HTTPAction
{:template transform-json-with-nested-parameters}) | |
(mi/define-simple-hydration-method model
:model
"Return the Card this action uses as a model."
[{:keys [model_id]}]
(t2/select-one Card :id model_id)) | |
(defn- check-model-is-not-a-saved-question
[model-id]
(when-not (t2/select-one-fn :dataset Card :id model-id)
(throw (ex-info (tru "Actions must be made with models, not cards.")
{:status-code 400})))) | |
(t2/define-before-insert :model/Action
[{model-id :model_id, :as action}]
(u/prog1 action
(check-model-is-not-a-saved-question model-id))) | |
(t2/define-before-update :model/Action
[{archived? :archived, id :id, model-id :model_id, :as changes}]
(u/prog1 changes
(if archived?
(t2/delete! :model/DashboardCard :action_id id)
(check-model-is-not-a-saved-question model-id)))) | |
(defmethod mi/perms-objects-set :model/Action [instance read-or-write] (mi/perms-objects-set (t2/select-one Card :id (:model_id instance)) read-or-write)) | |
The columns that are common to all Action types. | (def action-columns [:archived :created_at :creator_id :description :entity_id :made_public_by_id :model_id :name :parameter_mappings :parameters :public_uuid :type :updated_at :visualization_settings]) |
Returns the model from an action type.
| (defn type->model
[action-type]
(case action-type
:http :model/HTTPAction
:implicit :model/ImplicitAction
:query :model/QueryAction)) |
------------------------------------------------ CRUD fns ----------------------------------------------------- | |
Inserts an Action and related type table. Returns the action id. | (defn insert!
[action-data]
(t2/with-transaction [_conn]
(let [action (first (t2/insert-returning-instances! Action (select-keys action-data action-columns)))
model (type->model (:type action))]
(t2/query-one {:insert-into (t2/table-name model)
:values [(-> (apply dissoc action-data action-columns)
(assoc :action_id (:id action))
(cond->
(= (:type action) :implicit)
(dissoc :database_id)
(= (:type action) :http)
(update :template json/encode)
(= (:type action) :query)
(update :dataset_query json/encode)))]})
(:id action)))) |
Updates an Action and the related type table. Deletes the old type table row if the type has changed. | (defn update!
[{:keys [id] :as action} existing-action]
(when-let [action-row (not-empty (select-keys action action-columns))]
(t2/update! Action id action-row))
(when-let [type-row (not-empty (cond-> (apply dissoc action :id action-columns)
(= (or (:type action) (:type existing-action))
:implicit)
(dissoc :database_id)))]
(let [type-row (assoc type-row :action_id id)
existing-model (type->model (:type existing-action))]
(if (and (:type action) (not= (:type action) (:type existing-action)))
(let [new-model (type->model (:type action))]
(t2/delete! existing-model :action_id id)
(t2/insert! new-model (assoc type-row :action_id id)))
(t2/update! existing-model id type-row))))) |
(defn- hydrate-subtype [action]
(let [subtype (type->model (:type action))]
(-> action
(merge (t2/select-one subtype :action_id (:id action)))
(dissoc :action_id)))) | |
(defn- normalize-query-actions [actions]
(when (seq actions)
(let [query-actions (t2/select QueryAction :action_id [:in (map :id actions)])
action-id->query-actions (m/index-by :action_id query-actions)]
(for [action actions]
(merge action (-> action :id action-id->query-actions (dissoc :action_id))))))) | |
(defn- normalize-http-actions [actions]
(when (seq actions)
(let [http-actions (t2/select HTTPAction :action_id [:in (map :id actions)])
http-actions-by-action-id (m/index-by :action_id http-actions)]
(map (fn [action]
(let [http-action (get http-actions-by-action-id (:id action))]
(-> action
(merge
{:disabled false}
(select-keys http-action [:template :response_handle :error_handle])
(select-keys (:template http-action) [:parameters :parameter_mappings])))))
actions)))) | |
(defn- normalize-implicit-actions [actions]
(when (seq actions)
(let [implicit-actions (t2/select ImplicitAction :action_id [:in (map :id actions)])
implicit-actions-by-action-id (m/index-by :action_id implicit-actions)]
(map (fn [action]
(let [implicit-action (get implicit-actions-by-action-id (:id action))]
(merge action
(select-keys implicit-action [:kind]))))
actions)))) | |
Select Actions and fill in sub type information. Don't use this if you need implicit parameters
for implicit actions, use [[select-action]] instead.
| (defn- select-actions-without-implicit-params
[& options]
(let [{:keys [query http implicit]} (group-by :type (apply t2/select Action options))
query-actions (normalize-query-actions query)
http-actions (normalize-http-actions http)
implicit-actions (normalize-implicit-actions implicit)]
(sort-by :updated_at (concat query-actions http-actions implicit-actions)))) |
Makes sure that if | (defn unique-field-slugs? [fields] (empty? (m/filter-vals #(not= % 1) (frequencies (map (comp u/slugify :name) fields))))) |
Returns a map of card-id -> implicit-parameters for the given models | (defn- implicit-action-parameters
[cards]
(let [card-by-table-id (into {}
(for [card cards
:let [{:keys [table-id]} (query/query->database-and-table-ids (:dataset_query card))]
:when table-id]
[table-id card]))
tables (when-let [table-ids (seq (keys card-by-table-id))]
(t2/hydrate (t2/select 'Table :id [:in table-ids]) :fields))]
(into {}
(for [table tables
:let [fields (:fields table)]
;; Skip tables for have conflicting slugified columns i.e. table has "name" and "NAME" columns.
:when (unique-field-slugs? fields)
:let [card (get card-by-table-id (:id table))
id->metadata (m/index-by :id (:result_metadata card))
parameters (->> fields
;; get display_name from metadata
(keep (fn [field]
(when-let [metadata (id->metadata (:id field))]
(assoc field :display_name (:display_name metadata)))))
;; remove exploded json fields and any structured field
(remove (some-fn
;; exploded json fields can't be recombined in sql yet
:nfc_path
;; their parents, a json field, nor things like cidr, macaddr, xml, etc
(comp #(isa? % :type/Structured) :effective_type)
;; or things which we don't recognize
(comp #{:type/*} :effective_type)))
(map (fn [field]
{:id (u/slugify (:name field))
:display-name (:display_name field)
:target [:variable [:template-tag (u/slugify (:name field))]]
:type (:base_type field)
:required (:database_required field)
:is-auto-increment (:database_is_auto_increment field)
::field-id (:id field)
::pk? (isa? (:semantic_type field) :type/PK)})))]]
[(:id card) parameters])))) |
Find actions with given options and generate implicit parameters for execution. Also adds the Pass in known-models to save a second Card lookup. | (defn select-actions
[known-models & options]
(let [actions (apply select-actions-without-implicit-params options)
implicit-action-model-ids (set (map :model_id (filter #(= :implicit (:type %)) actions)))
implicit-action-models (if known-models
(->> known-models
(filter #(contains? implicit-action-model-ids (:id %)))
distinct)
(when (seq implicit-action-model-ids)
(t2/select 'Card :id [:in implicit-action-model-ids])))
model-id->db-id (into {} (for [card implicit-action-models]
[(:id card) (:database_id card)]))
model-id->implicit-parameters (when (seq implicit-action-models)
(implicit-action-parameters implicit-action-models))]
(for [action actions]
(if (= (:type action) :implicit)
(let [model-id (:model_id action)
saved-params (m/index-by :id (:parameters action))
action-kind (:kind action)
implicit-params (cond->> (get model-id->implicit-parameters model-id)
:always
(map (fn [param] (merge param (get saved-params (:id param)))))
(= "row/delete" action-kind)
(filter ::pk?)
(= "row/create" action-kind)
(remove #(or (:is-auto-increment %)
;; non-required PKs like column with default is uuid_generate_v4()
(and (::pk? %) (not (:required %)))))
(contains? #{"row/update" "row/delete"} action-kind)
(map (fn [param] (cond-> param (::pk? param) (assoc :required true))))
:always
(map #(dissoc % ::pk? ::field-id)))]
(cond-> (assoc action :database_id (model-id->db-id (:model_id action)))
(seq implicit-params)
(-> (assoc :parameters implicit-params)
(update-in [:visualization_settings :fields]
(fn [fields]
(let [param-ids (map :id implicit-params)
fields (->> (or fields {})
;; remove entries that don't match params (in case of deleted columns)
(m/filter-keys (set param-ids)))]
;; add default entries for params that don't have an entry
(reduce (fn [acc param-id]
(if (contains? acc param-id)
acc
(assoc acc param-id {:id param-id, :hidden false})))
fields
param-ids)))))))
action)))) |
Selects an Action and fills in the subtype data and implicit parameters.
| (defn select-action [& options] (first (apply select-actions nil options))) |
Adds a boolean field | (defn- map-assoc-database-enable-actions
[actions]
(let [action-ids (map :id actions)
get-database-enable-actions (fn [{:keys [settings]}]
(boolean (some-> settings
((get-in (t2/transforms :model/Database) [:settings :out]))
:database-enable-actions)))
id->database-enable-actions (into {}
(map (juxt :id get-database-enable-actions))
(t2/query {:select [:action.id :db.settings]
:from :action
:join [[:report_card :card] [:= :card.id :action.model_id]
[:metabase_database :db] [:= :db.id :card.database_id]]
:where [:in :action.id action-ids]}))]
(map (fn [action]
(assoc action :database_enabled_actions (get id->database-enable-actions (:id action))))
actions))) |
(mi/define-batched-hydration-method dashcard-action
:dashcard/action
"Hydrates actions from DashboardCards. Adds a boolean field `:database-enabled-actions` to each action according to the
`database-enable-actions` setting for the action's database."
[dashcards]
(let [actions-by-id (when-let [action-ids (seq (keep :action_id dashcards))]
(->> (select-actions nil :id [:in action-ids])
map-assoc-database-enable-actions
(m/index-by :id)))]
(for [dashcard dashcards]
(m/assoc-some dashcard :action (get actions-by-id (:action_id dashcard)))))) | |
Get the action associated with a dashcard if exists, return | (defn dashcard->action
[dashcard-or-dashcard-id]
(some->> (t2/select-one-fn :action_id :model/DashboardCard :id (u/the-id dashcard-or-dashcard-id))
(select-action :id))) |
------------------------------------------------ Serialization --------------------------------------------------- | |
(defmethod serdes/extract-query "Action" [_model _opts]
(eduction (map hydrate-subtype)
(t2/reducible-select Action))) | |
(defmethod serdes/hash-fields :model/Action [_action] [:name (serdes/hydrated-hash :model) :created_at]) | |
(defmethod serdes/extract-one "Action" [_model-name _opts action]
(-> (serdes/extract-one-basics "Action" action)
(update :creator_id serdes/*export-user*)
(update :model_id serdes/*export-fk* 'Card)
(update :type name)
(cond-> (= (:type action) :query)
(update :database_id serdes/*export-fk-keyed* 'Database :name)))) | |
(defmethod serdes/load-xform "Action" [action]
(-> action
serdes/load-xform-basics
(update :creator_id serdes/*import-user*)
(update :model_id serdes/*import-fk* 'Card)
(update :type keyword)
(cond-> (= (:type action) "query")
(update :database_id serdes/*import-fk-keyed* 'Database :name)))) | |
(defmethod serdes/ingested-model-columns "Action" [_ingested]
(into #{} (conj action-columns :database_id :dataset_query :kind :template :response_handle :error_handle :type))) | |
(defmethod serdes/load-update! "Action" [_model-name ingested local] (log/tracef "Upserting Action %d: old %s new %s" (:id local) (pr-str local) (pr-str ingested)) (update! (assoc ingested :id (:id local)) local) (select-action :id (:id local))) | |
(defmethod serdes/load-insert! "Action" [_model-name ingested] (log/tracef "Inserting Action: %s" (pr-str ingested)) (insert! ingested)) | |
(defmethod serdes/dependencies "Action" [action]
(concat [[{:model "Card" :id (:model_id action)}]]
(when (= (:type action) "query")
[[{:model "Database" :id (:database_id action)}]]))) | |
(defmethod serdes/storage-path "Action" [action _ctx]
(let [{:keys [id label]} (-> action serdes/path last)]
["actions" (serdes/storage-leaf-file-name id label)])) | |
(ns metabase.models.activity (:require [metabase.api.common :as api] [metabase.models.interface :as mi] [metabase.util.malli :as mu] [methodical.core :as methodical] [toucan2.core :as t2])) | |
------------------------------------------------- Perms Checking ------------------------------------------------- | |
(def ^:private model->entity
{"card" :model/Card
"dashboard" :model/Dashboard
"metric" :model/Metric
"pulse" :model/Pulse
"segment" :model/Segment}) | |
Implementation for | (defmulti can-?
{:arglists '([perms-check-fn activity])}
(fn [_ {:keys [topic]}]
topic)) |
For now only admins can see when another user joined -- we don't want every user knowing about every other user. In the future we might want to change this and come up with some sort of system where we can determine which users get to see other users -- perhaps if they are in a group together other than 'All Users' | (defmethod can-? :user-joined [_ _] api/*is-superuser?*) |
For every other activity topic we'll look at the read/write perms for the object the activty is about (e.g. a Card or Dashboard). For all other activity feed items with no model everyone can read/write | (defmethod can-? :default [perms-check-fn {model :model, model-id :model_id}]
(if-let [object (when-let [entity (model->entity model)]
(t2/select entity model-id))]
(perms-check-fn object)
true)) |
----------------------------------------------- Entity & Lifecycle ----------------------------------------------- | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase. | (def Activity :model/Activity) |
(methodical/defmethod t2/table-name :model/Activity [_model] :activity) | |
(t2/define-before-insert :model/Activity
[activity]
(let [defaults {:timestamp :%now
:details {}}]
(merge defaults activity))) | |
(t2/deftransforms :model/Activity
{:details mi/transform-json
:topic mi/transform-keyword}) | |
(doto :model/Activity (derive :metabase/model)) | |
(defmethod mi/can-read? :model/Activity [& args] (apply can-? mi/can-read? args)) | |
(defmethod mi/can-write? Activity [& args] (apply can-? mi/can-write? args)) | |
------------------------------------------------------ Etc. ------------------------------------------------------ | |
Persistence Functions | |
TODO - this is probably the exact wrong way to have written this functionality. This could have been a multimethod or protocol, and various entity classes could implement it; Furthermore, we could have just used current-user-id to get the responsible user, instead of leaving it open to user error. | |
Inserts a new Takes the following kwargs:
:topic Required. The activity topic.
:user-id Required. ID of the ex: (record-activity! :topic :event/segment-update :object segment :database-id 1 :table-id 13) | (mu/defn record-activity!
[{:keys [topic object details database-id
table-id user-id model model-id]
:or {object {}}} :- [:map {:closed true}
[:topic :keyword]
[:user-id {:optional true} [:maybe pos-int?]]
[:model {:optional true} [:maybe :string]]
[:model-id {:optional true} [:maybe pos-int?]]
[:object {:optional true} [:maybe :map]]
[:details {:optional true} [:maybe :map]]
[:database-id {:optional true} [:maybe pos-int?]]
[:table-id {:optional true} [:maybe pos-int?]]]]
(first (t2/insert-returning-instances! Activity
;; strip off the `:event/` namespace of the topic, added in 0.48.0
:topic (keyword (name topic))
:user_id user-id
:model model
:model_id model-id
:database_id database-id
:table_id table-id
;; TODO: test if this custom id is tracked
:custom_id (:custom_id object)
:details (or details object)))) |
(ns metabase.models.api-key
(:require [crypto.random :as crypto-random]
[metabase.models.audit-log :as audit-log]
[metabase.models.interface :as mi]
[metabase.models.permissions-group :as perms-group]
[metabase.util :as u]
[metabase.util.password :as u.password]
[metabase.util.secret :as u.secret]
[methodical.core :as methodical]
[toucan2.core :as t2])) | |
the prefix length, the length of | (def ^:private prefix-length 7) |
the total number of bytes of randomness we generate for API keys | (def ^:private bytes-key-length 32) |
(methodical/defmethod t2/table-name :model/ApiKey [_model] :api_key) | |
(mi/define-batched-hydration-method add-group
:group
"Add to each ApiKey a single group. Assume that each ApiKey is a member of either zero or one groups other than
the 'All Users' group."
[api-keys]
(when (seq api-keys)
(let [api-key-id->permissions-groups
(group-by :api-key-id
(t2/query {:select [[:pg.name :group-name]
[:pg.id :group-id]
[:api_key.id :api-key-id]]
:from [[:permissions_group :pg]]
:join [[:permissions_group_membership :pgm]
[:= :pgm.group_id :pg.id]
:api_key [:= :api_key.user_id :pgm.user_id]]
:where [:in :api_key.id (map u/the-id api-keys)]}))
api-key-id->group
(fn [api-key-id]
(let [{name :group-name
id :group-id} (->> (api-key-id->permissions-groups api-key-id)
(sort-by #(= (:group-id %) (u/the-id (perms-group/all-users))))
first)]
{:name name :id id}))]
(for [api-key api-keys]
(assoc api-key :group (api-key-id->group (u/the-id api-key))))))) | |
(doto :model/ApiKey (derive :metabase/model) (derive :hook/timestamped?)) | |
Given an API key, returns the standardized prefix for that API key. | (defn prefix [key] (apply str (take prefix-length key))) |
(defn- add-prefix [{:keys [unhashed_key] :as api-key}]
(cond-> api-key
(contains? api-key :unhashed_key)
(assoc :key_prefix (some-> unhashed_key u.secret/expose prefix)))) | |
Generates a new API key - a random base64 string prefixed with | (defn generate-key [] (u.secret/secret (str "mb_" (crypto-random/base64 bytes-key-length)))) |
(def ^:private string-key-length (count (u.secret/expose (generate-key)))) | |
Given an API key, returns a string of the same length with all but the prefix masked with | (defn mask
[key]
(->> (concat (prefix key) (repeat "*"))
(take string-key-length)
(apply str))) |
Adds the | (defn- add-key
[{:keys [unhashed_key] :as api-key}]
(cond-> api-key
(contains? api-key :unhashed_key)
(assoc :key (some-> unhashed_key u.secret/expose u.password/hash-bcrypt))
true (dissoc :unhashed_key))) |
(t2/define-before-insert :model/ApiKey
[api-key]
(-> api-key
add-prefix
add-key)) | |
(t2/define-before-update :model/ApiKey
[api-key]
(-> api-key
add-prefix
add-key)) | |
(defn- add-masked-key [api-key]
(if-let [prefix (:key_prefix api-key)]
(assoc api-key :masked_key (mask prefix))
api-key)) | |
(t2/define-after-select :model/ApiKey
[api-key]
(-> api-key
add-masked-key)) | |
(defmethod audit-log/model-details :model/ApiKey [entity _event-type] (select-keys entity [:name :group :key_prefix :user_id])) | |
(ns metabase.models.application-permissions-revision (:require [metabase.models.interface :as mi] [metabase.util.i18n :refer [tru]] [methodical.core :as methodical] [toucan2.core :as t2])) | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase. | (def ApplicationPermissionsRevision :model/ApplicationPermissionsRevision) |
(methodical/defmethod t2/table-name :model/ApplicationPermissionsRevision [_model] :application_permissions_revision) | |
(doto :model/ApplicationPermissionsRevision (derive :metabase/model) (derive :hook/created-at-timestamped?)) | |
(t2/deftransforms :model/ApplicationPermissionsRevision
{:before mi/transform-json
:after mi/transform-json}) | |
(t2/define-before-update :model/ApplicationPermissionsRevision [_] (throw (Exception. (tru "You cannot update a PermissionsRevision!")))) | |
Return the ID of the newest | (defn latest-id
[]
(or (t2/select-one-pk ApplicationPermissionsRevision {:order-by [[:id :desc]]})
0)) |
Model defenition for the Metabase Audit Log, which tracks actions taken by users across the Metabase app. This is distinct from the Activity and View Log models, which predate this namespace, and which power specific API endpoints used for in-app functionality, such as the recently-viewed items displayed on the homepage. | (ns metabase.models.audit-log (:require [clojure.data :as data] [clojure.set :as set] [metabase.api.common :as api] [metabase.models.activity :as activity] [metabase.models.interface :as mi] [metabase.public-settings.premium-features :as premium-features] [metabase.util :as u] [metabase.util.malli :as mu] [metabase.util.malli.registry :as mr] [metabase.util.malli.schema :as ms] [methodical.core :as m] [steffan-westcott.clj-otel.api.trace.span :as span] [toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
(doto :model/AuditLog (derive :metabase/model)) | |
(m/defmethod t2/table-name :model/AuditLog [_model] :audit_log) | |
(t2/deftransforms :model/AuditLog
{:topic mi/transform-keyword
:details mi/transform-json}) | |
Returns a map with data about an entity that should be included in the | (defmulti model-details
{:arglists '([entity event-type])}
mi/dispatch-on-model) |
(defmethod model-details :default
[_entity _event-type]
{}) | |
(def ^:private model-name->audit-logged-name
{"RootCollection" "Collection"}) | |
Given an instance of a model or a keyword model identifier, returns the name to store in the database as a string, or | (defn model-name
[instance-or-model]
(let [model (or (t2/model instance-or-model) instance-or-model)
raw-model-name (cond
(keyword? model) (name model)
(class? model) (.getSimpleName ^java.lang.Class model))]
(model-name->audit-logged-name raw-model-name raw-model-name))) |
Returns a map with previous and new versions of the objects, _keeping only fields that are present in both but have changed values_. | (defn- prepare-update-event-data
[object previous-object]
(let [[previous-only new-only _both] (data/diff previous-object object)
shared-updated-keys (set/intersection (set (keys previous-only)) (set (keys new-only)))]
{:previous (select-keys previous-object shared-updated-keys)
:new (select-keys object shared-updated-keys)})) |
(mr/def ::event-params [:map {:closed true
:doc "Used when inserting a value to the Audit Log."}
[:object {:optional true} [:maybe :map]]
[:previous-object {:optional true} [:maybe :map]]
[:user-id {:optional true} [:maybe pos-int?]]
[:model {:optional true} [:maybe [:or :keyword :string]]]
[:model-id {:optional true} [:maybe pos-int?]]
[:details {:optional true} [:maybe :map]]]) | |
(mu/defn construct-event
:- [:map
[:unqualified-topic simple-keyword?]
[:user-id [:maybe ms/PositiveInt]]
[:model-name [:maybe :string]]
[:model-id [:maybe ms/PositiveInt]]
[:details :map]]
"Generates the data to be recorded in the Audit Log."
([topic :- :keyword
params :- ::event-params
current-user-id :- [:maybe pos-int?]]
(let [unqualified-topic (keyword (name topic))
object (:object params)
previous-object (:previous-object params)
object-details (model-details object unqualified-topic)
previous-details (model-details previous-object unqualified-topic)]
{:unqualified-topic unqualified-topic
:user-id (or (:user-id params) current-user-id)
:model-name (model-name (or (:model params) object))
:model-id (or (:model-id params) (u/id object))
:details (merge {}
(:details params)
(if (not-empty previous-object)
(prepare-update-event-data object-details previous-details)
object-details))}))) | |
Returns true when we should record audit data into the audit log. | (defn- log-enabled?
[]
(or (premium-features/is-hosted?)
(premium-features/has-feature? :audit-app))) |
Records an event in the Audit Log.
Under certain conditions this function does not insert anything into the audit log. - If nothing is logged, returns nil - Otherwise, returns the audit logged row. | (mu/defn record-event!
[topic :- :keyword
params :- ::event-params]
(when (log-enabled?)
(span/with-span!
{:name "record-event!"
:attributes (cond-> {}
(:model-id params) (assoc :model/id (:model-id params))
(:user-id params) (assoc :user/id (:user-id params))
(:model params) (assoc :model/name (u/lower-case-en (:model params))))}
(let [{:keys [user-id model-name model-id details unqualified-topic object]}
(construct-event topic params api/*current-user-id*)]
(t2/insert! :model/AuditLog
:topic unqualified-topic
:details details
:model model-name
:model_id model-id
:user_id user-id)
;; TODO: temporarily double-writing to the `activity` table, delete this in Metabase v48
;; TODO figure out set of events to actually continue recording in activity
(when-not (#{:card-read :dashboard-read :table-read :card-query :setting-update} unqualified-topic)
(activity/record-activity!
{:topic topic
:object object
:details details
:model model-name
:model-id model-id
:user-id user-id})))))) |
(t2/define-before-insert :model/AuditLog
[activity]
(let [defaults {:timestamp :%now
:details {}}]
(merge defaults activity))) | |
(ns metabase.models.bookmark (:require [clojure.string :as str] [metabase.db.connection :as mdb.connection] [metabase.db.query :as mdb.query] [metabase.db.util :as mdb.u] [metabase.models.card :refer [Card]] [metabase.models.collection :refer [Collection]] [metabase.models.dashboard :refer [Dashboard]] [metabase.util.honey-sql-2 :as h2x] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [methodical.core :as methodical] [toucan2.core :as t2])) | |
CardBookmark model Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase." DashboardBookmark model CollectionBookmark model BookmarkOrdering model | (def CardBookmark :model/CardBookmark) (def DashboardBookmark :model/DashboardBookmark) (def CollectionBookmark :model/CollectionBookmark) (def BookmarkOrdering :model/BookmarkOrdering) |
(methodical/defmethod t2/table-name :model/CardBookmark [_model] :card_bookmark) (methodical/defmethod t2/table-name :model/DashboardBookmark [_model] :dashboard_bookmark) (methodical/defmethod t2/table-name :model/CollectionBookmark [_model] :collection_bookmark) (methodical/defmethod t2/table-name :model/BookmarkOrdering [_model] :bookmark_ordering) | |
(derive :model/CardBookmark :metabase/model) (derive :model/DashboardBookmark :metabase/model) (derive :model/CollectionBookmark :metabase/model) (derive :model/BookmarkOrdering :metabase/model) | |
(defn- unqualify-key [k] (-> (str/split (name k) #"\.") peek keyword)) | |
Shape of a bookmark returned for user. Id is a string because it is a concatenation of the model and the model's id. This is required for the frontend entity loading system and does not refer to any particular bookmark id, although the compound key can be inferred from it. | (def BookmarkResult
[:map {:closed true}
[:id :string]
[:type [:enum "card" "collection" "dashboard"]]
[:item_id ms/PositiveInt]
[:name ms/NonBlankString]
[:authority_level {:optional true} [:maybe :string]]
[:dataset {:optional true} [:maybe :boolean]]
[:description {:optional true} [:maybe :string]]
[:display {:optional true} [:maybe :string]]]) |
(mu/defn ^:private normalize-bookmark-result :- BookmarkResult
"Normalizes bookmark results. Bookmarks are left joined against the card, collection, and dashboard tables, but only
points to one of them. Normalizes it so it has just the desired fields."
[result]
(let [result (cond-> (into {} (remove (comp nil? second) result))
;; If not a collection then remove collection properties
;; to avoid shadowing the "real" properties.
(not= (:type result) "collection")
(dissoc :collection.description :collection.name))
normalized-result (zipmap (map unqualify-key (keys result)) (vals result))
id-str (str (:type normalized-result) "-" (:item_id normalized-result))]
(-> normalized-result
(select-keys [:item_id :type :name :dataset :description :display
:authority_level])
(assoc :id id-str)))) | |
(defn- bookmarks-union-query
[user-id]
(let [as-null (when (= (mdb.connection/db-type) :postgres) (h2x/->integer nil))]
{:union-all [{:select [:card_id
[as-null :dashboard_id]
[as-null :collection_id]
[:card_id :item_id]
[(h2x/literal "card") :type]
:created_at]
:from [:card_bookmark]
:where [:= :user_id user-id]}
{:select [[as-null :card_id]
:dashboard_id
[as-null :collection_id]
[:dashboard_id :item_id]
[(h2x/literal "dashboard") :type]
:created_at]
:from [:dashboard_bookmark]
:where [:= :user_id user-id]}
{:select [[as-null :card_id]
[as-null :dashboard_id]
:collection_id
[:collection_id :item_id]
[(h2x/literal "collection") :type]
:created_at]
:from [:collection_bookmark]
:where [:= :user_id user-id]}]})) | |
(mu/defn bookmarks-for-user :- [:sequential BookmarkResult]
"Get all bookmarks for a user. Each bookmark will have a string id made of the model and model-id, a type, and
item_id, name, and description from the underlying bookmarked item."
[user-id]
(->> (mdb.query/query
{:select [[:bookmark.created_at :created_at]
[:bookmark.type :type]
[:bookmark.item_id :item_id]
[:card.name (mdb.u/qualify Card :name)]
[:card.dataset (mdb.u/qualify Card :dataset)]
[:card.display (mdb.u/qualify Card :display)]
[:card.description (mdb.u/qualify Card :description)]
[:card.archived (mdb.u/qualify Card :archived)]
[:dashboard.name (mdb.u/qualify Dashboard :name)]
[:dashboard.description (mdb.u/qualify Dashboard :description)]
[:dashboard.archived (mdb.u/qualify Dashboard :archived)]
[:collection.name (mdb.u/qualify Collection :name)]
[:collection.authority_level (mdb.u/qualify Collection :authority_level)]
[:collection.description (mdb.u/qualify Collection :description)]
[:collection.archived (mdb.u/qualify Collection :archived)]]
:from [[(bookmarks-union-query user-id) :bookmark]]
:left-join [[:report_card :card] [:= :bookmark.card_id :card.id]
[:report_dashboard :dashboard] [:= :bookmark.dashboard_id :dashboard.id]
;; use of [[h2x/identifier]] here is a workaround for https://github.com/seancorfield/honeysql/issues/450
[:collection :collection] [:in :collection.id [(h2x/identifier :field :bookmark :collection_id)
(h2x/identifier :field :dashboard :collection_id)]]
[:bookmark_ordering :bookmark_ordering] [:and
[:= :bookmark_ordering.user_id user-id]
[:= :bookmark_ordering.type :bookmark.type]
[:= :bookmark_ordering.item_id :bookmark.item_id]]]
:where (into [:and]
(for [table [:card :dashboard :collection]
:let [field (keyword (str (name table) "." "archived"))]]
[:or [:= field false] [:= field nil]]))
:order-by [[:bookmark_ordering.ordering (case (mdb.connection/db-type)
;; NULLS LAST is not supported by MySQL, but this is default
;; behavior for MySQL anyway
(:postgres :h2) :asc-nulls-last
:mysql :asc)]
[:created_at :desc]]})
(map normalize-bookmark-result))) | |
Saves a bookmark ordering of shape | (defn save-ordering!
[user-id orderings]
(t2/delete! BookmarkOrdering :user_id user-id)
(t2/insert! BookmarkOrdering (->> orderings
(map #(select-keys % [:type :item_id]))
(map-indexed #(assoc %2 :user_id user-id :ordering %1))))) |
Underlying DB model for what is now most commonly referred to as a 'Question' in most user-facing situations. Card is a historical name, but is the same thing; both terms are used interchangeably in the backend codebase. | (ns metabase.models.card
(:require
[clojure.core.async :as a]
[clojure.data :as data]
[clojure.set :as set]
[clojure.string :as str]
[clojure.walk :as walk]
[malli.core :as mc]
[medley.core :as m]
[metabase.api.common :as api]
[metabase.config :as config]
[metabase.db.query :as mdb.query]
[metabase.email.messages :as messages]
[metabase.events :as events]
[metabase.mbql.normalize :as mbql.normalize]
[metabase.mbql.schema :as mbql.s]
[metabase.models.audit-log :as audit-log]
[metabase.models.collection :as collection]
[metabase.models.field-values :as field-values]
[metabase.models.interface :as mi]
[metabase.models.moderation-review :as moderation-review]
[metabase.models.parameter-card
:as parameter-card
:refer [ParameterCard]]
[metabase.models.params :as params]
[metabase.models.permissions :as perms]
[metabase.models.pulse :as pulse]
[metabase.models.query :as query]
[metabase.models.revision :as revision]
[metabase.models.serialization :as serdes]
[metabase.moderation :as moderation]
[metabase.plugins.classloader :as classloader]
[metabase.public-settings :as public-settings]
[metabase.public-settings.premium-features
:as premium-features
:refer [defenterprise]]
[metabase.query-processor.async :as qp.async]
[metabase.query-processor.util :as qp.util]
[metabase.server.middleware.session :as mw.session]
[metabase.shared.util.i18n :refer [trs]]
[metabase.sync.analyze.query-results :as qr]
[metabase.util :as u]
[metabase.util.i18n :refer [tru]]
[metabase.util.log :as log]
[methodical.core :as methodical]
[schema.core :as s]
[toucan2.core :as t2]
[toucan2.tools.hydrate :as t2.hydrate])
(:import
(clojure.core.async.impl.channels ManyToManyChannel))) |
(set! *warn-on-reflection* true) | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all the Card symbol in our codebase. | (def Card :model/Card) |
(methodical/defmethod t2/table-name :model/Card [_model] :report_card) | |
(methodical/defmethod t2.hydrate/model-for-automagic-hydration [#_model :default #_k :card] [_original-model _k] :model/Card) | |
(t2/deftransforms :model/Card
{:dataset_query mi/transform-metabase-query
:display mi/transform-keyword
:embedding_params mi/transform-json
:query_type mi/transform-keyword
:result_metadata mi/transform-result-metadata
:visualization_settings mi/transform-visualization-settings
:parameters mi/transform-parameters-list
:parameter_mappings mi/transform-parameters-list}) | |
(doto :model/Card (derive :metabase/model) ;; You can read/write a Card if you can read/write its parent Collection (derive ::perms/use-parent-collection-perms) (derive :hook/timestamped?) (derive :hook/entity-id)) | |
(defmethod mi/can-write? Card
([instance]
;; Cards in audit collection should not be writable.
(if (and
;; We want to make sure there's an existing audit collection before doing the equality check below.
;; If there is no audit collection, this will be nil:
(some? (:id (perms/default-audit-collection)))
;; Is a direct descendant of audit collection
(= (:collection_id instance) (:id (perms/default-audit-collection))))
false
(mi/current-user-has-full-permissions? (perms/perms-objects-set-for-parent-collection instance :write))))
([_ pk]
(mi/can-write? (t2/select-one :model/Card :id pk)))) | |
(defmethod mi/can-read? Card ([instance] (perms/can-read-audit-helper :model/Card instance)) ([_ pk] (mi/can-read? (t2/select-one :model/Card :id pk)))) | |
-------------------------------------------------- Hydration -------------------------------------------------- | |
(mi/define-simple-hydration-method dashboard-count
:dashboard_count
"Return the number of Dashboards this Card is in."
[{:keys [id]}]
(t2/count 'DashboardCard, :card_id id)) | |
(mi/define-simple-hydration-method parameter-usage-count
:parameter_usage_count
"Return the number of dashboard/card filters and other widgets that use this card to populate their available
values (via ParameterCards)"
[{:keys [id]}]
(t2/count ParameterCard, :card_id id)) | |
(mi/define-simple-hydration-method average-query-time
:average_query_time
"Average query time of card, taken by query executions which didn't hit cache. If it's nil we don't have any query
executions on file."
[{:keys [id]}]
(-> (mdb.query/query {:select [:%avg.running_time]
:from [:query_execution]
:where [:and
[:not= :running_time nil]
[:not= :cache_hit true]
[:= :card_id id]]})
first vals first)) | |
(mi/define-simple-hydration-method last-query-start
:last_query_start
"Timestamp for start of last query of this card."
[{:keys [id]}]
(-> (mdb.query/query {:select [:%max.started_at]
:from [:query_execution]
:where [:and
[:not= :running_time nil]
[:not= :cache_hit true]
[:= :card_id id]]})
first vals first)) | |
There's more hydration in the shared metabase.moderation namespace, but it needs to be required: | (comment moderation/keep-me) |
--------------------------------------------------- Revisions ---------------------------------------------------- | |
(def ^:private excluded-columns-for-card-revision [:id :created_at :updated_at :entity_id :creator_id :public_uuid :made_public_by_id :metabase_version]) | |
(defmethod revision/serialize-instance :model/Card
([instance]
(revision/serialize-instance Card nil instance))
([_model _id instance]
(cond-> (apply dissoc instance excluded-columns-for-card-revision)
;; datasets should preserve edits to metadata
(not (:dataset instance))
(dissoc :result_metadata)))) | |
--------------------------------------------------- Lifecycle ---------------------------------------------------- | |
Lift | (defn populate-query-fields
[{{query-type :type, :as outer-query} :dataset_query, :as card}]
(merge
card
;; mega HACK FIXME -- don't update this stuff when doing deserialization because it might differ from what's in the
;; YAML file and break tests like [[metabase-enterprise.serialization.v2.e2e.yaml-test/e2e-storage-ingestion-test]].
;; The root cause of this issue is that we're generating Cards that have a different Database ID or Table ID from
;; what's actually in their query -- we need to fix [[metabase.test.generate]], but I'm not sure how to do that
(when-not mi/*deserializing?*
(when-let [{:keys [database-id table-id]} (and query-type
(query/query->database-and-table-ids outer-query))]
(merge
{:query_type (keyword query-type)}
(when database-id
{:database_id database-id})
(when table-id
{:table_id table-id})))))) |
When inserting/updating a Card, populate the result metadata column if not already populated by inferring the metadata from the query. | (defn- populate-result-metadata
[{query :dataset_query, metadata :result_metadata, existing-card-id :id, :as card}]
(cond
;; not updating the query => no-op
(not query)
(do
(log/debug "Not inferring result metadata for Card: query was not updated")
card)
;; passing in metadata => no-op
metadata
(do
(log/debug "Not inferring result metadata for Card: metadata was passed in to insert!/update!")
card)
;; this is an update, and dataset_query hasn't changed => no-op
(and existing-card-id
(= query (t2/select-one-fn :dataset_query Card :id existing-card-id)))
(do
(log/debugf "Not inferring result metadata for Card %s: query has not changed" existing-card-id)
card)
;; query has changed (or new Card) and this is a native query => set metadata to nil
;;
;; we can't infer the metadata for a native query without running it, so it's better to have no metadata than
;; possibly incorrect metadata.
(= (:type query) :native)
(do
(log/debug "Can't infer result metadata for Card: query is a native query. Setting result metadata to nil")
(assoc card :result_metadata nil))
;; otherwise, attempt to infer the metadata. If the query can't be run for one reason or another, set metadata to
;; nil.
:else
(do
(log/debug "Attempting to infer result metadata for Card")
(let [inferred-metadata (not-empty (mw.session/with-current-user nil
(classloader/require 'metabase.query-processor)
(u/ignore-exceptions
((resolve 'metabase.query-processor/query->expected-cols) query))))]
(assoc card :result_metadata inferred-metadata))))) |
Check that a | (defn- check-for-circular-source-query-references
[{query :dataset_query, id :id}] ; don't use `u/the-id` here so that we can use this with `pre-insert` too
(loop [query query, ids-already-seen #{id}]
(let [source-card-id (qp.util/query->source-card-id query)]
(cond
(not source-card-id)
:ok
(ids-already-seen source-card-id)
(throw
(ex-info (tru "Cannot save Question: source query has circular references.")
{:status-code 400}))
:else
(recur (or (t2/select-one-fn :dataset_query Card :id source-card-id)
(throw (ex-info (tru "Card {0} does not exist." source-card-id)
{:status-code 404})))
(conj ids-already-seen source-card-id)))))) |
(defn- maybe-normalize-query [card]
(cond-> card
(seq (:dataset_query card)) (update :dataset_query mbql.normalize/normalize))) | |
Transforms native query's TODO: move this to [[metabase.query-processor.card]] or MLv2 so the logic can be shared between the backend and frontend
NOTE: this should mirror | (defn template-tag-parameters
[card]
(for [[_ {tag-type :type, widget-type :widget-type, :as tag}] (get-in card [:dataset_query :native :template-tags])
:when (and tag-type
(or (contains? mbql.s/raw-value-template-tag-types tag-type)
(and (= tag-type :dimension) widget-type (not= widget-type :none))))]
{:id (:id tag)
:type (or widget-type (cond (= tag-type :date) :date/single
(= tag-type :string) :string/=
(= tag-type :number) :number/=
:else :category))
:target (if (= tag-type :dimension)
[:dimension [:template-tag (:name tag)]]
[:variable [:template-tag (:name tag)]])
:name (:display-name tag)
:slug (:name tag)
:default (:default tag)
:required (boolean (:required tag))})) |
Check that all native query Field filter parameters reference Fields belonging to the Database the query points against. This is done when saving a Card. The goal here is to prevent people from saving Cards with invalid queries -- it's better to error now then to error down the road in Query Processor land. The usual way a user gets into the situation of having a mismatch between the Database and Field Filters is by creating a native query in the Query Builder UI, adding parameters, and then changing the Database that the query targets. See https://github.com/metabase/metabase/issues/14145 for more details. | (defn- check-field-filter-fields-are-from-correct-database
[{{query-db-id :database, :as query} :dataset_query, :as card}]
;; for updates if `query` isn't being updated we don't need to validate anything.
(when query
(when-let [field-ids (not-empty (params/card->template-tag-field-ids card))]
(doseq [{:keys [field-id field-name table-name field-db-id]} (mdb.query/query
{:select [[:field.id :field-id]
[:field.name :field-name]
[:table.name :table-name]
[:table.db_id :field-db-id]]
:from [[:metabase_field :field]]
:left-join [[:metabase_table :table]
[:= :field.table_id :table.id]]
:where [:in :field.id (set field-ids)]})]
(when-not (= field-db-id query-db-id)
(throw (ex-info (letfn [(describe-database [db-id]
(format "%d %s" db-id (pr-str (t2/select-one-fn :name 'Database :id db-id))))]
(tru "Invalid Field Filter: Field {0} belongs to Database {1}, but the query is against Database {2}"
(format "%d %s.%s" field-id (pr-str table-name) (pr-str field-name))
(describe-database field-db-id)
(describe-database query-db-id)))
{:status-code 400
:query-database query-db-id
:field-filter-database field-db-id}))))))) |
Check that the card is a valid model if being saved as one. Throw an exception if not. | (defn- assert-valid-model
[{:keys [dataset dataset_query]}]
(when dataset
(let [template-tag-types (->> (vals (get-in dataset_query [:native :template-tags]))
(map (comp keyword :type)))]
(when (some (complement #{:card :snippet}) template-tag-types)
(throw (ex-info (tru "A model made from a native SQL question cannot have a variable or field filter.")
{:status-code 400})))))) |
TODO -- consider whether we should validate the Card query when you save/update it?? | (defn- pre-insert [card]
(let [defaults {:parameters []
:parameter_mappings []}
card (merge defaults card)]
(u/prog1 card
;; make sure this Card doesn't have circular source query references
(check-for-circular-source-query-references card)
(check-field-filter-fields-are-from-correct-database card)
;; TODO: add a check to see if all id in :parameter_mappings are in :parameters
(assert-valid-model card)
(params/assert-valid-parameters card)
(params/assert-valid-parameter-mappings card)
(collection/check-collection-namespace Card (:collection_id card))))) |
Checks additional sandboxing constraints for Metabase Enterprise Edition. The OSS implementation is a no-op. | (defenterprise pre-update-check-sandbox-constraints metabase-enterprise.sandbox.models.group-table-access-policy [_]) |
Update the config of parameter on any Dashboard/Card use this Remove parameter.valuessourcetype and set parameter.valuessourcetype to nil ( the default type ) when: - card is archived - card.result_metadata changes and the parameter values source field can't be found anymore | (defn- update-parameters-using-card-as-values-source
[{id :id, :as changes}]
(let [parameter-cards (t2/select ParameterCard :card_id id)]
(doseq [[[po-type po-id] param-cards]
(group-by (juxt :parameterized_object_type :parameterized_object_id) parameter-cards)]
(let [model (case po-type :card 'Card :dashboard 'Dashboard)
{:keys [parameters]} (t2/select-one [model :parameters] :id po-id)
affected-param-ids-set (cond
;; update all parameters that use this card as source
(:archived changes)
(set (map :parameter_id param-cards))
;; update only parameters that have value_field no longer in this card
(:result_metadata changes)
(let [param-id->parameter (m/index-by :id parameters)]
(->> param-cards
(filter (fn [param-card]
;; if cant find the value-field in result_metadata, then we should remove it
(nil? (qp.util/field->field-info
(get-in (param-id->parameter (:parameter_id param-card)) [:values_source_config :value_field])
(:result_metadata changes)))))
(map :parameter_id)
set))
:else #{})
new-parameters (map (fn [parameter]
(if (affected-param-ids-set (:id parameter))
(-> parameter
(assoc :values_source_type nil)
(dissoc :values_source_config))
parameter))
parameters)]
(when-not (= parameters new-parameters)
(t2/update! model po-id {:parameters new-parameters})))))) |
A model with implicit action supported iff they are a raw table, meaning there are no clauses such as filter, limit, breakout... It should be the opposite of [[metabase.lib.stage/has-clauses]] but for all stages. | (defn model-supports-implicit-actions?
[{dataset-query :dataset_query :as _card}]
(and (= :query (:type dataset-query))
(every? #(nil? (get-in dataset-query [:query %]))
[:expressions :filter :limit :breakout :aggregation :joins :order-by :fields]))) |
Delete all implicit actions of a model if exists. | (defn- disable-implicit-action-for-model!
[model-id]
(when-let [action-ids (t2/select-pks-set 'Action {:select [:action.id]
:from [:action]
:join [:implicit_action
[:= :action.id :implicit_action.action_id]]
:where [:= :action.model_id model-id]})]
(t2/delete! 'Action :id [:in action-ids]))) |
(defn- pre-update [{archived? :archived, id :id, :as changes}]
;; TODO - don't we need to be doing the same permissions check we do in `pre-insert` if the query gets changed? Or
;; does that happen in the `PUT` endpoint?
(u/prog1 changes
(let [;; Fetch old card data if necessary, and share the data between multiple checks.
old-card-info (when (or (contains? changes :dataset)
(:dataset_query changes)
(get-in changes [:dataset_query :native]))
(t2/select-one [:model/Card :dataset_query :dataset] :id id))]
;; if the Card is archived, then remove it from any Dashboards
(when archived?
(t2/delete! 'DashboardCard :card_id id))
;; if the template tag params for this Card have changed in any way we need to update the FieldValues for
;; On-Demand DB Fields
(when (get-in changes [:dataset_query :native])
(let [old-param-field-ids (params/card->template-tag-field-ids old-card-info)
new-param-field-ids (params/card->template-tag-field-ids changes)]
(when (and (seq new-param-field-ids)
(not= old-param-field-ids new-param-field-ids))
(let [newly-added-param-field-ids (set/difference new-param-field-ids old-param-field-ids)]
(log/info "Referenced Fields in Card params have changed. Was:" old-param-field-ids
"Is Now:" new-param-field-ids
"Newly Added:" newly-added-param-field-ids)
;; Now update the FieldValues for the Fields referenced by this Card.
(field-values/update-field-values-for-on-demand-dbs! newly-added-param-field-ids)))))
;; make sure this Card doesn't have circular source query references if we're updating the query
(when (:dataset_query changes)
(check-for-circular-source-query-references changes))
;; updating a model dataset query to not support implicit actions will disable implicit actions if they exist
(when (and (:dataset_query changes)
(:dataset old-card-info)
(not (model-supports-implicit-actions? changes)))
(disable-implicit-action-for-model! id))
;; Archive associated actions
(when (and (false? (:dataset changes))
(:dataset old-card-info))
(t2/update! 'Action {:model_id id :type [:not= :implicit]} {:archived true})
(t2/delete! 'Action :model_id id, :type :implicit))
;; Make sure any native query template tags match the DB in the query.
(check-field-filter-fields-are-from-correct-database changes)
;; Make sure the Collection is in the default Collection namespace (e.g. as opposed to the Snippets Collection namespace)
(collection/check-collection-namespace Card (:collection_id changes))
(params/assert-valid-parameters changes)
(params/assert-valid-parameter-mappings changes)
(update-parameters-using-card-as-values-source changes)
(parameter-card/upsert-or-delete-from-parameters! "card" id (:parameters changes))
;; additional checks (Enterprise Edition only)
(pre-update-check-sandbox-constraints changes)
(assert-valid-model (merge old-card-info changes))))) | |
(t2/define-after-select :model/Card [card] (public-settings/remove-public-uuid-if-public-sharing-is-disabled card)) | |
(t2/define-before-insert :model/Card
[card]
(-> card
(assoc :metabase_version config/mb-version-string)
maybe-normalize-query
populate-result-metadata
pre-insert
populate-query-fields)) | |
(t2/define-after-insert :model/Card
[card]
(u/prog1 card
(when-let [field-ids (seq (params/card->template-tag-field-ids card))]
(log/info "Card references Fields in params:" field-ids)
(field-values/update-field-values-for-on-demand-dbs! field-ids))
(parameter-card/upsert-or-delete-from-parameters! "card" (:id card) (:parameters card)))) | |
(t2/define-before-update :model/Card
[card]
;; remove all the unchanged keys from the map, except for `:id`, so the functions below can do the right thing since
;; they were written pre-Toucan 2 and don't know about [[t2/changes]]...
;;
;; We have to convert this to a plain map rather than a Toucan 2 instance at this point to work around upstream bug
;; https://github.com/camsaul/toucan2/issues/145 .
(-> (into {:id (:id card)} (t2/changes card))
maybe-normalize-query
populate-result-metadata
pre-update
populate-query-fields
(dissoc :id))) | |
Cards don't normally get deleted (they get archived instead) so this mostly affects tests | (t2/define-before-delete :model/Card
[{:keys [id] :as _card}]
;; delete any ParameterCard that the parameters on this card linked to
(parameter-card/delete-all-for-parameterized-object! "card" id)
;; delete any ParameterCard linked to this card
(t2/delete! ParameterCard :card_id id)
(t2/delete! 'ModerationReview :moderated_item_type "card", :moderated_item_id id)
(t2/delete! 'Revision :model "Card", :model_id id)) |
(defmethod serdes/hash-fields :model/Card [_card] [:name (serdes/hydrated-hash :collection) :created_at]) | |
----------------------------------------------- Creating Cards ---------------------------------------------------- | |
(s/defn result-metadata-async :- ManyToManyChannel
"Return a channel of metadata for the passed in `query`. Takes the `original-query` so it can determine if existing
`metadata` might still be valid. Takes `dataset?` since existing metadata might need to be \"blended\" into the
fresh metadata to preserve metadata edits from the dataset.
Note this condition is possible for new cards and edits to cards. New cards can be created from existing cards by
copying, and they could be datasets, have edited metadata that needs to be blended into a fresh run.
This is also complicated because everything is optional, so we cannot assume the client will provide metadata and
might need to save a metadata edit, or might need to use db-saved metadata on a modified dataset."
[{:keys [original-query query metadata original-metadata dataset?]}]
(let [valid-metadata? (and metadata (mc/validate qr/ResultsMetadata metadata))]
(cond
(or
;; query didn't change, preserve existing metadata
(and (= (mbql.normalize/normalize original-query)
(mbql.normalize/normalize query))
valid-metadata?)
;; only sent valid metadata in the edit. Metadata might be the same, might be different. We save in either case
(and (nil? query)
valid-metadata?)
;; copying card and reusing existing metadata
(and (nil? original-query)
query
valid-metadata?))
(do
(log/debug (trs "Reusing provided metadata"))
(a/to-chan! [metadata]))
;; frontend always sends query. But sometimes programatic don't (cypress, API usage). Returning an empty channel
;; means the metadata won't be updated at all.
(nil? query)
(do
(log/debug (trs "No query provided so not querying for metadata"))
(doto (a/chan) a/close!))
;; datasets need to incorporate the metadata either passed in or already in the db. Query has changed so we
;; re-run and blend the saved into the new metadata
(and dataset? (or valid-metadata? (seq original-metadata)))
(do
(log/debug (trs "Querying for metadata and blending model metadata"))
(a/go (let [metadata' (if valid-metadata?
(map mbql.normalize/normalize-source-metadata metadata)
original-metadata)
fresh (a/<! (qp.async/result-metadata-for-query-async query))]
(qp.util/combine-metadata fresh metadata'))))
:else
;; compute fresh
(do
(log/debug (trs "Querying for metadata"))
(qp.async/result-metadata-for-query-async query))))) | |
Duration in milliseconds to wait for the metadata before saving the card without the metadata. That metadata will be saved later when it is ready. | (def metadata-sync-wait-ms 1500) |
Duration in milliseconds to wait for the metadata before abandoning the asynchronous metadata saving. Default is 15 minutes. | (def metadata-async-timeout-ms (u/minutes->ms 15)) |
Save metadata when (and if) it is ready. Takes a chan that will eventually return metadata. Waits up to [[metadata-async-timeout-ms]] for the metadata, and then saves it if the query of the card has not changed. | (defn schedule-metadata-saving
[result-metadata-chan card]
(a/go
(let [timeoutc (a/timeout metadata-async-timeout-ms)
[metadata port] (a/alts! [result-metadata-chan timeoutc])
id (:id card)]
(cond (= port timeoutc)
(do (a/close! result-metadata-chan)
(log/info (trs "Metadata not ready in {0} minutes, abandoning"
(long (/ metadata-async-timeout-ms 1000 60)))))
(not (seq metadata))
(log/info (trs "Not updating metadata asynchronously for card {0} because no metadata"
id))
:else
(future
(let [current-query (t2/select-one-fn :dataset_query Card :id id)]
(if (= (:dataset_query card) current-query)
(do (t2/update! Card id {:result_metadata metadata})
(log/info (trs "Metadata updated asynchronously for card {0}" id)))
(log/info (trs "Not updating metadata asynchronously for card {0} because query has changed"
id))))))))) |
Create a new Card. Metadata will be fetched off thread. If the metadata takes longer than [[metadata-sync-wait-ms]] the card will be saved without metadata and it will be saved to the card in the future when it is ready. Dispatches the | (defn create-card!
([card creator] (create-card! card creator false))
([{:keys [dataset_query result_metadata dataset parameters parameter_mappings], :as card-data} creator delay-event?]
;; `zipmap` instead of `select-keys` because we want to get `nil` values for keys that aren't present. Required by
;; `api/maybe-reconcile-collection-position!`
(let [data-keys [:dataset_query :description :display :name :visualization_settings
:parameters :parameter_mappings :collection_id :collection_position :cache_ttl]
card-data (assoc (zipmap data-keys (map card-data data-keys))
:creator_id (:id creator)
:dataset (boolean (:dataset card-data))
:parameters (or parameters [])
:parameter_mappings (or parameter_mappings []))
result-metadata-chan (result-metadata-async {:query dataset_query
:metadata result_metadata
:dataset? dataset})
metadata-timeout (a/timeout metadata-sync-wait-ms)
[metadata port] (a/alts!! [result-metadata-chan metadata-timeout])
timed-out? (= port metadata-timeout)
card (t2/with-transaction [_conn]
;; Adding a new card at `collection_position` could cause other cards in this
;; collection to change position, check that and fix it if needed
(api/maybe-reconcile-collection-position! card-data)
(first (t2/insert-returning-instances! Card (cond-> card-data
(and metadata (not timed-out?))
(assoc :result_metadata metadata)))))]
(when-not delay-event?
(events/publish-event! :event/card-create {:object card :user-id (:id creator)}))
(when timed-out?
(log/info (trs "Metadata not available soon enough. Saving new card and asynchronously updating metadata")))
;; include same information returned by GET /api/card/:id since frontend replaces the Card it currently has with
;; returned one -- See #4283
(u/prog1 card
(when timed-out?
(schedule-metadata-saving result-metadata-chan <>)))))) |
------------------------------------------------- Updating Cards ------------------------------------------------- | |
(defn- card-archived? [old-card new-card]
(and (not (:archived old-card))
(:archived new-card))) | |
(defn- line-area-bar? [display]
(contains? #{:line :area :bar} display)) | |
(defn- progress? [display] (= :progress display)) | |
(defn- allows-rows-alert? [display]
(not (contains? #{:line :bar :area :progress} display))) | |
Alerts no longer make sense when the kind of question being alerted on significantly changes. Setting up an alert when a time series query reaches 10 is no longer valid if the question switches from a line graph to a table. This function goes through various scenarios that render an alert no longer valid | (defn- display-change-broke-alert?
[{old-display :display} {new-display :display}]
(when-not (= old-display new-display)
(or
;; Did the alert switch from a table type to a line/bar/area/progress graph type?
(and (allows-rows-alert? old-display)
(or (line-area-bar? new-display)
(progress? new-display)))
;; Switching from a line/bar/area to another type that is not those three invalidates the alert
(and (line-area-bar? old-display)
(not (line-area-bar? new-display)))
;; Switching from a progress graph to anything else invalidates the alert
(and (progress? old-display)
(not (progress? new-display)))))) |
If we had a goal before, and now it's gone, the alert is no longer valid | (defn- goal-missing? [old-card new-card] (and (get-in old-card [:visualization_settings :graph.goal_value]) (not (get-in new-card [:visualization_settings :graph.goal_value])))) |
If there are multiple breakouts and a goal, we don't know which breakout to compare to the goal, so it invalidates the alert | (defn- multiple-breakouts?
[{:keys [display] :as new-card}]
(and (get-in new-card [:visualization_settings :graph.goal_value])
(or (line-area-bar? display)
(progress? display))
(< 1 (count (get-in new-card [:dataset_query :query :breakout]))))) |
Removes all of the alerts and notifies all of the email recipients of the alerts change via | (defn- delete-alert-and-notify!
[& {:keys [notify-fn! alerts actor]}]
(t2/delete! :model/Pulse :id [:in (map :id alerts)])
(doseq [{:keys [channels] :as alert} alerts
:let [email-channel (m/find-first #(= :email (:channel_type %)) channels)]]
(doseq [recipient (:recipients email-channel)]
(notify-fn! alert recipient actor)))) |
Removes all alerts and will email each recipient letting them know | (defn delete-alert-and-notify-archived!
[& {:keys [alerts actor]}]
(delete-alert-and-notify! {:notify-fn! messages/send-alert-stopped-because-archived-email!
:alerts alerts
:actor actor})) |
(defn- delete-alert-and-notify-changed! [& {:keys [alerts actor]}]
(delete-alert-and-notify! {:notify-fn! messages/send-alert-stopped-because-changed-email!
:alerts alerts
:actor actor})) | |
(defn- delete-alerts-if-needed! [& {:keys [old-card new-card actor]}]
;; If there are alerts, we need to check to ensure the card change doesn't invalidate the alert
(when-let [alerts (binding [pulse/*allow-hydrate-archived-cards* true]
(seq (pulse/retrieve-alerts-for-cards {:card-ids [(:id new-card)]})))]
(cond
(card-archived? old-card new-card)
(delete-alert-and-notify-archived! :alerts alerts, :actor actor)
(or (display-change-broke-alert? old-card new-card)
(goal-missing? old-card new-card)
(multiple-breakouts? new-card))
(delete-alert-and-notify-changed! :alerts alerts, :actor actor)
;; The change doesn't invalidate the alert, do nothing
:else
nil))) | |
Return true if card is verified, false otherwise. Assumes that moderation reviews are ordered so that the most recent is the first. This is the case from the hydration function for moderation_reviews. | (defn- card-is-verified?
[card]
(-> card :moderation_reviews first :status #{"verified"} boolean)) |
Return whether there were any changes in the objects at the keys for returns false because changes to collection_id are ignored: (changed? #{:description} {:collection_id 1 :description "foo"} {:collection_id 2 :description "foo"}) returns true: (changed? #{:description} {:collection_id 1 :description "foo"} {:collection_id 2 :description "diff"}) | (defn- changed?
[consider card-before updates]
;; have to ignore keyword vs strings over api. `{:type :query}` vs `{:type "query"}`
(let [prepare (fn prepare [card] (walk/prewalk (fn [x] (if (keyword? x)
(name x)
x))
card))
before (prepare (select-keys card-before consider))
after (prepare (select-keys updates consider))
[_ changes-in-after] (data/diff before after)]
(boolean (seq changes-in-after)))) |
When comparing a card to possibly unverify, only consider these keys as changing something 'important' about the query. | (def ^:private card-compare-keys
#{:table_id
:database_id
:query_type ;; these first three may not even be changeable
:dataset_query}) |
Update a Card. Metadata is fetched asynchronously. If it is ready before [[metadata-sync-wait-ms]] elapses it will be included, otherwise the metadata will be saved to the database asynchronously. | (defn update-card!
[{:keys [card-before-update card-updates actor]}]
;; don't block our precious core.async thread, run the actual DB updates on a separate thread
(t2/with-transaction [_conn]
(api/maybe-reconcile-collection-position! card-before-update card-updates)
(when (and (card-is-verified? card-before-update)
(changed? card-compare-keys card-before-update card-updates))
;; this is an enterprise feature but we don't care if enterprise is enabled here. If there is a review we need
;; to remove it regardless if enterprise edition is present at the moment.
(moderation-review/create-review! {:moderated_item_id (:id card-before-update)
:moderated_item_type "card"
:moderator_id (:id actor)
:status nil
:text (tru "Unverified due to edit")}))
;; ok, now save the Card
(t2/update! Card (:id card-before-update)
;; `collection_id` and `description` can be `nil` (in order to unset them). Other values should only be
;; modified if they're passed in as non-nil
(u/select-keys-when card-updates
:present #{:collection_id :collection_position :description :cache_ttl :dataset}
:non-nil #{:dataset_query :display :name :visualization_settings :archived :enable_embedding
:parameters :parameter_mappings :embedding_params :result_metadata :collection_preview})))
;; Fetch the updated Card from the DB
(let [card (t2/select-one Card :id (:id card-before-update))]
(delete-alerts-if-needed! :old-card card-before-update, :new-card card, :actor actor)
;; skip publishing the event if it's just a change in its collection position
(when-not (= #{:collection_position}
(set (keys card-updates)))
(events/publish-event! :event/card-update {:object card :user-id api/*current-user-id*}))
card)) |
------------------------------------------------- Serialization -------------------------------------------------- | |
(defmethod serdes/extract-query "Card" [_ opts] (serdes/extract-query-collections Card opts)) | |
(defn- export-result-metadata [card metadata]
(when (and metadata (:dataset card))
(for [m metadata]
(-> (dissoc m :fingerprint)
(m/update-existing :table_id serdes/*export-table-fk*)
(m/update-existing :id serdes/*export-field-fk*)
(m/update-existing :field_ref serdes/export-mbql))))) | |
(defn- import-result-metadata [metadata]
(when metadata
(for [m metadata]
(-> m
(m/update-existing :table_id serdes/*import-table-fk*)
(m/update-existing :id serdes/*import-field-fk*)
(m/update-existing :field_ref serdes/import-mbql))))) | |
(defn- result-metadata-deps [metadata]
(when (seq metadata)
(reduce set/union #{} (for [m (seq metadata)]
(reduce set/union (serdes/mbql-deps (:field_ref m))
[(when (:table_id m) #{(serdes/table->path (:table_id m))})
(when (:id m) #{(serdes/field->path (:id m))})]))))) | |
(defmethod serdes/extract-one "Card"
[_model-name _opts card]
;; Cards have :table_id, :database_id, :collection_id, :creator_id that need conversion.
;; :table_id and :database_id are extracted as just :table_id [database_name schema table_name].
;; :collection_id is extracted as its entity_id or identity-hash.
;; :creator_id as the user's email.
(try
(-> (serdes/extract-one-basics "Card" card)
(update :database_id serdes/*export-fk-keyed* 'Database :name)
(update :table_id serdes/*export-table-fk*)
(update :collection_id serdes/*export-fk* 'Collection)
(update :creator_id serdes/*export-user*)
(update :made_public_by_id serdes/*export-user*)
(update :dataset_query serdes/export-mbql)
(update :parameters serdes/export-parameters)
(update :parameter_mappings serdes/export-parameter-mappings)
(update :visualization_settings serdes/export-visualization-settings)
(update :result_metadata (partial export-result-metadata card)))
(catch Exception e
(throw (ex-info (format "Failed to export Card: %s" (ex-message e)) {:card card} e))))) | |
(defmethod serdes/load-xform "Card"
[card]
(-> card
serdes/load-xform-basics
(update :database_id serdes/*import-fk-keyed* 'Database :name)
(update :table_id serdes/*import-table-fk*)
(update :creator_id serdes/*import-user*)
(update :made_public_by_id serdes/*import-user*)
(update :collection_id serdes/*import-fk* 'Collection)
(update :dataset_query serdes/import-mbql)
(update :parameters serdes/import-parameters)
(update :parameter_mappings serdes/import-parameter-mappings)
(update :visualization_settings serdes/import-visualization-settings)
(update :result_metadata import-result-metadata))) | |
(defmethod serdes/dependencies "Card"
[{:keys [collection_id database_id dataset_query parameters parameter_mappings
result_metadata table_id visualization_settings]}]
(->> (map serdes/mbql-deps parameter_mappings)
(reduce set/union #{})
(set/union (serdes/parameters-deps parameters))
(set/union #{[{:model "Database" :id database_id}]})
; table_id and collection_id are nullable.
(set/union (when table_id #{(serdes/table->path table_id)}))
(set/union (when collection_id #{[{:model "Collection" :id collection_id}]}))
(set/union (result-metadata-deps result_metadata))
(set/union (serdes/mbql-deps dataset_query))
(set/union (serdes/visualization-settings-deps visualization_settings))
vec)) | |
(defmethod serdes/descendants "Card" [_model-name id]
(let [card (t2/select-one Card :id id)
source-table (some-> card :dataset_query :query :source-table)
template-tags (some->> card :dataset_query :native :template-tags vals (keep :card-id))
parameters-card-id (some->> card :parameters (keep (comp :card_id :values_source_config)))
snippets (some->> card :dataset_query :native :template-tags vals (keep :snippet-id))]
(set/union
(when (and (string? source-table)
(str/starts-with? source-table "card__"))
#{["Card" (Integer/parseInt (.substring ^String source-table 6))]})
(when (seq template-tags)
(set (for [card-id template-tags]
["Card" card-id])))
(when (seq parameters-card-id)
(set (for [card-id parameters-card-id]
["Card" card-id])))
(when (seq snippets)
(set (for [snippet-id snippets]
["NativeQuerySnippet" snippet-id])))))) | |
------------------------------------------------ Audit Log -------------------------------------------------------- | |
(defmethod audit-log/model-details :model/Card
[{dataset? :dataset :as card} _event-type]
(merge (select-keys card [:name :description :database_id :table_id])
;; Use `model` instead of `dataset` to mirror product terminology
{:model? dataset?})) | |
Collections are used to organize Cards, Dashboards, and Pulses; as of v0.30, they are the primary way we determine
permissions for these objects.
| (ns metabase.models.collection
(:refer-clojure :exclude [ancestors descendants])
(:require
[clojure.core.memoize :as memoize]
[clojure.set :as set]
[clojure.string :as str]
[metabase.api.common
:as api
:refer [*current-user-id* *current-user-permissions-set*]]
[metabase.db.connection :as mdb.connection]
[metabase.models.collection.root :as collection.root]
[metabase.models.interface :as mi]
[metabase.models.permissions :as perms :refer [Permissions]]
[metabase.models.serialization :as serdes]
[metabase.permissions.util :as perms.u]
[metabase.public-settings.premium-features :as premium-features]
[metabase.util :as u]
[metabase.util.honey-sql-2 :as h2x]
[metabase.util.i18n :refer [trs tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[methodical.core :as methodical]
[potemkin :as p]
[toucan2.core :as t2]
[toucan2.protocols :as t2.protocols]
[toucan2.realize :as t2.realize])) |
(set! *warn-on-reflection* true) | |
(comment collection.root/keep-me) (comment mdb.connection/keep-me) ;; for [[memoize/ttl]] | |
for [[memoize/ttl]] | |
(p/import-vars [collection.root root-collection root-collection-with-ui-details]) | |
Schema for things that are instances of [[metabase.models.collection.root.RootCollection]]. | (def ^:private RootCollection
[:fn
{:error/message (str "an instance of the root Collection")}
#'collection.root/is-root-collection?]) |
Maximum number of characters allowed in a Collection | (def ^:private ^:const collection-slug-max-length 510) |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], no2 it's a reference to the toucan2 model name. We'll keep this till we replace all the Card symbol in our codebase. | (def Collection :model/Collection) |
(methodical/defmethod t2/table-name :model/Collection [_model] :collection) | |
(methodical/defmethod t2/model-for-automagic-hydration [#_model :default #_k :collection] [_original-model _k] :model/Collection) | |
(t2/deftransforms :model/Collection
{:namespace mi/transform-keyword
:authority_level mi/transform-keyword}) | |
(doto Collection (derive :metabase/model) (derive :hook/entity-id) (derive ::mi/read-policy.full-perms-for-perms-set) (derive ::mi/write-policy.full-perms-for-perms-set)) | |
(defmethod mi/can-write? Collection
([instance]
(mi/can-write? :model/Collection (:id instance)))
([model pk]
(if (= pk (:id (perms/default-audit-collection)))
false
(mi/current-user-has-full-permissions? :write model pk)))) | |
(defmethod mi/can-read? Collection ([instance] (perms/can-read-audit-helper :model/Collection instance)) ([_ pk] (mi/can-read? (t2/select-one :model/Collection :id pk)))) | |
Malli Schema for valid collection authority levels. | (def AuthorityLevel [:enum "official"]) |
+----------------------------------------------------------------------------------------------------------------+ | Slug Validation | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- slugify [collection-name]
;; double-check that someone isn't trying to use a blank string as the collection name
(when (str/blank? collection-name)
(throw (ex-info (tru "Collection name cannot be blank!")
{:status-code 400, :errors {:name (tru "cannot be blank")}})))
(u/slugify collection-name collection-slug-max-length)) | |
+----------------------------------------------------------------------------------------------------------------+ | Nested Collections: Location Paths | +----------------------------------------------------------------------------------------------------------------+ | |
"Location Paths" are strings that keep track of where a Colllection lives in a filesystem-like hierarchy. Almost all of our backend code does not need to know this and can act as if there is no Collection hierarchy; it is, however, presented as such in the UI. Perhaps it is best to think of the hierarchy as a façade. For example, Collection 30 might have a Storing the relationship in this manner, rather than with foreign keys such as The following functions are useful for working with the Collection | |
* Don't use this directly! Instead use [[location-path->ids]]. * 'Explode' a | (defn- unchecked-location-path->ids
[location-path]
(for [^String id-str (rest (str/split location-path #"/"))]
(Integer/parseInt id-str))) |
(defn- valid-location-path? [s]
(boolean
(and (string? s)
(re-matches #"^/(\d+/)*$" s)
(let [ids (unchecked-location-path->ids s)]
(or (empty? ids)
(apply distinct? ids)))))) | |
Schema for a directory-style 'path' to the location of a Collection. | (def ^:private LocationPath [:fn #'valid-location-path?]) |
(mu/defn location-path :- LocationPath
"Build a 'location path' from a sequence of `collections-or-ids`.
(location-path 10 20) ; -> \"/10/20/\
[& collections-or-ids :- [:* [:or ms/PositiveInt :map]]]
(if-not (seq collections-or-ids)
"/"
(str
"/"
(str/join "/" (for [collection-or-id collections-or-ids]
(u/the-id collection-or-id)))
"/"))) | |
(mu/defn location-path->ids :- [:sequential ms/PositiveInt]
"'Explode' a `location-path` into a sequence of Collection IDs, and parse them as integers.
(location-path->ids \"/10/20/\") ; -> [10 20]"
[location-path :- LocationPath]
(unchecked-location-path->ids location-path)) | |
(mu/defn location-path->parent-id :- [:maybe ms/PositiveInt]
"Given a `location-path` fetch the ID of the direct of a Collection.
(location-path->parent-id \"/10/20/\") ; -> 20"
[location-path :- LocationPath]
(last (location-path->ids location-path))) | |
(mu/defn all-ids-in-location-path-are-valid? :- :boolean
"Do all the IDs in `location-path` belong to actual Collections? (This requires a DB call to check this, so this
should only be used when creating/updating a Collection. Don't use this for casual schema validation.)"
[location-path :- LocationPath]
(or
;; if location is just the root Collection there are no IDs in the path, so nothing to check
(= location-path "/")
;; otherwise get all the IDs in the path and then make sure the count Collections with those IDs matches the number
;; of IDs
(let [ids (location-path->ids location-path)]
(= (count ids)
(t2/count Collection :id [:in ids]))))) | |
Assert that the | (defn- assert-valid-location
[{:keys [location], :as collection}]
;; if setting/updating the `location` of this Collection make sure it matches the schema for valid location paths
(when (contains? collection :location)
(when-not (valid-location-path? location)
(let [msg (tru "Invalid Collection location: path is invalid.")]
(throw (ex-info msg {:status-code 400, :errors {:location msg}}))))
;; if this is a Personal Collection it's only allowed to go in the Root Collection: you can't put it anywhere else!
(when (:personal_owner_id collection)
(when-not (= location "/")
(let [msg (tru "You cannot move a Personal Collection.")]
(throw (ex-info msg {:status-code 400, :errors {:location msg}})))))
;; Also make sure that all the IDs referenced in the Location path actually correspond to real Collections
(when-not (all-ids-in-location-path-are-valid? location)
(let [msg (tru "Invalid Collection location: some or all ancestors do not exist.")]
(throw (ex-info msg {:status-code 404, :errors {:location msg}})))))) |
Check that the namespace of this Collection is valid -- it must belong to the same namespace as its parent Collection. | (defn- assert-valid-namespace
[{:keys [location], owner-id :personal_owner_id, collection-namespace :namespace, :as collection}]
{:pre [(contains? collection :namespace)]}
(when location
(when-let [parent-id (location-path->parent-id location)]
(let [parent-namespace (t2/select-one-fn :namespace Collection :id parent-id)]
(when-not (= (keyword collection-namespace) (keyword parent-namespace))
(let [msg (tru "Collection must be in the same namespace as its parent")]
(throw (ex-info msg {:status-code 400, :errors {:location msg}})))))))
;; non-default namespace Collections cannot be personal Collections
(when (and owner-id collection-namespace)
(let [msg (tru "Personal Collections must be in the default namespace")]
(throw (ex-info msg {:status-code 400, :errors {:personal_owner_id msg}}))))) |
(def ^:private CollectionWithLocationOrRoot
[:or
RootCollection
[:map
[:location LocationPath]]]) | |
Schema for a valid | (def CollectionWithLocationAndIDOrRoot
[:or
RootCollection
[:map
[:location LocationPath]
[:id ms/PositiveInt]]]) |
(mu/defn ^:private parent :- CollectionWithLocationAndIDOrRoot
"Fetch the parent Collection of `collection`, or the Root Collection special placeholder object if this is a
top-level Collection."
[collection :- CollectionWithLocationOrRoot]
(if-let [new-parent-id (location-path->parent-id (:location collection))]
(t2/select-one Collection :id new-parent-id)
root-collection)) | |
+----------------------------------------------------------------------------------------------------------------+ | Nested Collections: "Effective" Location Paths | +----------------------------------------------------------------------------------------------------------------+ | |
"Effective" Location Paths are location paths for Collections that exclude the IDs of Collections the current user isn't allowed to see. For example, if a Collection has a | |
Includes the possible values for visible collections, either | (def ^:private VisibleCollections
[:or
[:= :all]
[:set
[:or [:= "root"] ms/PositiveInt]]]) |
(mu/defn permissions-set->visible-collection-ids :- VisibleCollections
"Given a `permissions-set` (presumably those of the current user), return a set of IDs of Collections that the
permissions set allows you to view. For those with *root* permissions (e.g., an admin), this function will return
`:all`, signifying that you are allowed to view all Collections. For *Root Collection* permissions, the response
will include \"root\".
(permissions-set->visible-collection-ids #{\"/collection/10/\"}) ; -> #{10}
(permissions-set->visible-collection-ids #{\"/\"}) ; -> :all
(permissions-set->visible-collection-ids #{\"/collection/root/\"}) ; -> #{\"root\"}
You probably don't want to consume the results of this function directly -- most of the time, the reason you are
calling this function in the first place is because you want add a `FILTER` clause to an application DB query (e.g.
to only fetch Cards that belong to Collections visible to the current User). Use
[[visible-collection-ids->honeysql-filter-clause]] to generate a filter clause that handles all possible outputs of
this function correctly.
!!! IMPORTANT NOTE !!!
Because the result may include `nil` for the Root Collection, or may be `:all`, MAKE SURE YOU HANDLE THOSE
SITUATIONS CORRECTLY before using these IDs to make a DB call. Better yet, use
[[visible-collection-ids->honeysql-filter-clause]] to generate appropriate HoneySQL."
[permissions-set]
(if (contains? permissions-set "/")
:all
(set
(for [path permissions-set
:let [[_ id-str] (re-matches #"/collection/((?:\d+)|root)/(read/)?" path)]
:when id-str]
(cond-> id-str
(not= id-str "root") Integer/parseInt))))) | |
Generate an appropriate HoneySQL Guaranteed to always generate a valid HoneySQL form, so this can be used directly in a query without further checks. (t2/select Card {:where (collection/visible-collection-ids->honeysql-filter-clause (collection/permissions-set->visible-collection-ids @current-user-permissions-set))}) | (mu/defn visible-collection-ids->honeysql-filter-clause
([collection-ids :- VisibleCollections]
(visible-collection-ids->honeysql-filter-clause :collection_id collection-ids))
([collection-id-field :- :keyword
collection-ids :- VisibleCollections]
(if (= collection-ids :all)
true
(let [{non-root-ids false, root-id true} (group-by (partial = "root") collection-ids)
non-root-clause (when (seq non-root-ids)
[:in collection-id-field non-root-ids])
root-clause (when (seq root-id)
[:= collection-id-field nil])]
(cond
(and root-clause non-root-clause)
[:or root-clause non-root-clause]
(or root-clause non-root-clause)
(or root-clause non-root-clause)
:else
false))))) |
Generates an appropriate HoneySQL | (mu/defn visible-collection-ids->direct-visible-descendant-clause
[parent-collection :- CollectionWithLocationAndIDOrRoot, collection-ids :- VisibleCollections]
(let [parent-id (or (:id parent-collection) "")
child-literal (if (collection.root/is-root-collection? parent-collection)
"/"
(format "%%/%s/" (str parent-id)))]
(into
;; if the collection-ids are empty, the whole into turns into nil and we have a dangling [:and] clause in query.
;; the (1 = 1) is to prevent this
[:and [:= [:inline 1] [:inline 1]]]
(if (= collection-ids :all)
;; In the case that visible-collection-ids is all, that means there's no invisible collection ids
;; meaning, the effective children are always the direct children. So check for being a direct child.
[[:like :location (h2x/literal child-literal)]]
(let [to-disj-ids (location-path->ids (or (:effective_location parent-collection) "/"))
disj-collection-ids (apply disj collection-ids (conj to-disj-ids parent-id))]
(for [visible-collection-id disj-collection-ids]
[:not-like :location (h2x/literal (format "%%/%s/%%" (str visible-collection-id)))])))))) |
(mu/defn ^:private effective-location-path* :- [:maybe LocationPath]
([collection :- CollectionWithLocationOrRoot]
(if (collection.root/is-root-collection? collection)
nil
(effective-location-path* (:location collection)
(permissions-set->visible-collection-ids @*current-user-permissions-set*))))
([real-location-path :- LocationPath
allowed-collection-ids :- VisibleCollections]
(if (= allowed-collection-ids :all)
real-location-path
(apply location-path (for [id (location-path->ids real-location-path)
:when (contains? allowed-collection-ids id)]
id))))) | |
(mi/define-simple-hydration-method effective-location-path :effective_location "Given a `location-path` and a set of Collection IDs one is allowed to view (obtained from `permissions-set->visible-collection-ids` above), calculate the 'effective' location path (excluding IDs of Collections for which we do not have read perms) we should show to the User. When called with a single argument, `collection`, this is used as a hydration function to hydrate `:effective_location`." ([collection] (effective-location-path* collection)) ([real-location-path allowed-collection-ids] (effective-location-path* real-location-path allowed-collection-ids))) | |
+----------------------------------------------------------------------------------------------------------------+ | Nested Collections: Ancestors, Childrens, Child Collections | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn ^:private ancestors* :- [:maybe [:sequential (mi/InstanceOf Collection)]]
[{:keys [location]}]
(when-let [ancestor-ids (seq (location-path->ids location))]
(t2/select [Collection :name :id :personal_owner_id]
:id [:in ancestor-ids]
{:order-by [:location]}))) | |
(mi/define-simple-hydration-method ^:private ancestors :ancestors "Fetch ancestors (parent, grandparent, etc.) of a `collection`. These are returned in order starting with the highest-level (e.g. most distant) ancestor." [collection] (ancestors* collection)) | |
(mu/defn ^:private effective-ancestors* :- [:sequential [:or RootCollection (mi/InstanceOf Collection)]]
[collection :- CollectionWithLocationAndIDOrRoot]
(if (collection.root/is-root-collection? collection)
[]
(filter mi/can-read? (cons (root-collection-with-ui-details (:namespace collection)) (ancestors collection))))) | |
(mi/define-simple-hydration-method effective-ancestors
:effective_ancestors
"Fetch the ancestors of a `collection`, filtering out any ones the current User isn't allowed to see. This is used
in the UI to power the 'breadcrumb' path to the location of a given Collection. For example, suppose we have four
Collections, nested like:
A > B > C > D
The ancestors of D are:
[Root] > A > B > C
If the current User is allowed to see A and C, but not B, `effective-ancestors` of D will be:
[Root] > A > C
Thus the existence of C will be kept hidden from the current User, and for all intents and purposes the current User
can effectively treat A as the parent of C."
[collection]
(effective-ancestors* collection)) | |
(mu/defn ^:private parent-id* :- [:maybe ms/PositiveInt]
[{:keys [location]} :- CollectionWithLocationOrRoot]
(some-> location location-path->parent-id)) | |
(mi/define-simple-hydration-method parent-id :parent_id "Get the immediate parent `collection` id, if set." [collection] (parent-id* collection)) | |
(mu/defn children-location :- LocationPath
"Given a `collection` return a location path that should match the `:location` value of all the children of the
Collection.
(children-location collection) ; -> \"/10/20/30/\";
;; To get children of this collection:
(t2/select Collection :location \"/10/20/30/\")"
[{:keys [location], :as collection} :- CollectionWithLocationAndIDOrRoot]
(if (collection.root/is-root-collection? collection)
"/"
(str location (u/the-id collection) "/"))) | |
(def ^:private Children
[:schema
{:registry {::children [:and
(mi/InstanceOf Collection)
[:map
[:children [:set [:ref ::children]]]]]}}
[:ref ::children]]) | |
(mu/defn ^:private descendants :- [:set Children]
"Return all descendant Collections of a `collection`, including children, grandchildren, and so forth. This is done
primarily to power the `effective-children` feature below, and thus the descendants are returned in a hierarchy,
rather than as a flat set. e.g. results will be something like:
+-> B
|
A -+-> C -+-> D -> E
|
+-> F -> G
where each letter represents a Collection, and the arrows represent values of its respective `:children`
set."
[collection :- CollectionWithLocationAndIDOrRoot, & additional-honeysql-where-clauses]
;; first, fetch all the descendants of the `collection`, and build a map of location -> children. This will be used
;; so we can fetch the immediate children of each Collection
(let [location->children (group-by :location (t2/select [Collection :name :id :location :description]
{:where
(apply
vector
:and
[:like :location (str (children-location collection) "%")]
;; Only return the Personal Collection belonging to the Current
;; User, regardless of whether we should actually be allowed to see
;; it (e.g., admins have perms for all Collections). This is done
;; to keep the Root Collection View for admins from getting crazily
;; cluttered with Personal Collections belonging to randos
[:or
[:= :personal_owner_id nil]
[:= :personal_owner_id *current-user-id*]]
additional-honeysql-where-clauses)}))
;; Next, build a function to add children to a given `coll`. This function will recursively call itself to add
;; children to each child
add-children (fn add-children [coll]
(let [children (get location->children (children-location coll))]
(assoc coll :children (set (map add-children children)))))]
;; call the `add-children` function we just built on the root `collection` that was passed in.
(-> (add-children collection)
;; since this function will be used for hydration (etc.), return only the newly produced `:children`
;; key
:children))) | |
(mu/defn descendant-ids :- [:maybe [:set ms/PositiveInt]] "Return a set of IDs of all descendant Collections of a `collection`." [collection :- CollectionWithLocationAndIDOrRoot] (t2/select-pks-set Collection :location [:like (str (children-location collection) \%)])) | |
(mu/defn ^:private effective-children-where-clause
[collection & additional-honeysql-where-clauses]
(let [visible-collection-ids (permissions-set->visible-collection-ids @*current-user-permissions-set*)]
;; Collection B is an effective child of Collection A if...
(into
[:and
;; it is a descendant of Collection A
[:like :location (h2x/literal (str (children-location collection) "%"))]
;; it is visible.
(visible-collection-ids->honeysql-filter-clause :id visible-collection-ids)
;; it is NOT a descendant of a visible Collection other than A
(visible-collection-ids->direct-visible-descendant-clause (t2/hydrate collection :effective_location) visible-collection-ids)
;; don't want personal collections in collection items. Only on the sidebar
[:= :personal_owner_id nil]]
;; (any additional conditions)
additional-honeysql-where-clauses))) | |
(mu/defn effective-children-query :- [:map
[:select :any]
[:from :any]
[:where :any]]
"Return a query for the descendant Collections of a `collection`
that should be presented to the current user as the children of this Collection.
This takes into account descendants that get filtered out when the current user can't see them. For
example, suppose we have some Collections with a hierarchy like this:
+-> B
|
A -+-> C -+-> D -> E
|
+-> F -> G
Suppose the current User can see A, B, E, F, and G, but not C, or D. The 'effective' children of A would be B, E,
and F, and the current user would be presented with a hierarchy like:
+-> B
|
A -+-> E
|
+-> F -> G
You can think of this process as 'collapsing' the Collection hierarchy and removing nodes that aren't visible to
the current User. This needs to be done so we can give a User a way to navigate to nodes that they are allowed to
access, but that are children of Collections they cannot access; in the example above, E and F are such nodes."
[collection :- CollectionWithLocationAndIDOrRoot & additional-honeysql-where-clauses]
{:select [:id :name :description]
:from [[:collection :col]]
:where (apply effective-children-where-clause collection additional-honeysql-where-clauses)}) | |
(mu/defn ^:private effective-children* :- [:set (mi/InstanceOf Collection)]
[collection :- CollectionWithLocationAndIDOrRoot & additional-honeysql-where-clauses]
(set (t2/select [Collection :id :name :description]
{:where (apply effective-children-where-clause collection additional-honeysql-where-clauses)}))) | |
(mi/define-simple-hydration-method effective-children :effective_children "Get the descendant Collections of `collection` that should be presented to the current User as direct children of this Collection. See documentation for [[metabase.models.collection/effective-children-query]] for more details." [collection & additional-honeysql-where-clauses] (apply effective-children* collection additional-honeysql-where-clauses)) | |
+----------------------------------------------------------------------------------------------------------------+ | Recursive Operations: Moving & Archiving | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn perms-for-archiving :- [:set perms.u/PathSchema]
"Return the set of Permissions needed to archive or unarchive a `collection`. Since archiving a Collection is
*recursive* (i.e., it applies to all the descendant Collections of that Collection), we require write ('curate')
permissions for the Collection itself and all its descendants, but not for its parent Collection.
For example, suppose we have a Collection hierarchy like:
A > B > C
To move or archive B, you need write permissions for A, B, and C:
* A, because you are taking something out of it (by archiving it)
* B, because you are archiving it
* C, because by archiving its parent, you are archiving it as well"
[collection :- CollectionWithLocationAndIDOrRoot]
;; Make sure we're not trying to archive the Root Collection...
(when (collection.root/is-root-collection? collection)
(throw (Exception. (tru "You cannot archive the Root Collection."))))
;; Make sure we're not trying to archive the Custom Reports Collection...
(when (= (perms/default-custom-reports-collection) collection)
(throw (Exception. (tru "You cannot archive the Custom Reports Collection."))))
;; also make sure we're not trying to archive a PERSONAL Collection
(when (t2/exists? Collection :id (u/the-id collection), :personal_owner_id [:not= nil])
(throw (Exception. (tru "You cannot archive a Personal Collection."))))
(set
(for [collection-or-id (cons
(parent collection)
(cons
collection
(t2/select-pks-set Collection :location [:like (str (children-location collection) "%")])))]
(perms/collection-readwrite-path collection-or-id)))) | |
(mu/defn perms-for-moving :- [:set perms.u/PathSchema]
"Return the set of Permissions needed to move a `collection`. Like archiving, moving is recursive, so we require
perms for both the Collection and its descendants; we additionally require permissions for its new parent Collection.
For example, suppose we have a Collection hierarchy of three Collections, A, B, and C, and a forth Collection, D,
and we want to move B from A to D:
A > B > C A
===>
D D > B > C
To move or archive B, you would need write permissions for A, B, C, and D:
* A, because we're moving something out of it
* B, since it's the Collection we're operating on
* C, since it will by definition be affected too
* D, because it's the new parent Collection, and moving something into it requires write perms."
[collection :- CollectionWithLocationAndIDOrRoot
new-parent :- CollectionWithLocationAndIDOrRoot]
;; Make sure we're not trying to move the Root Collection...
(when (collection.root/is-root-collection? collection)
(throw (Exception. (tru "You cannot move the Root Collection."))))
;; Needless to say, it makes no sense to move a Collection into itself or into one of its descendants. So let's make
;; sure we're not doing that...
(when (contains? (set (location-path->ids (children-location new-parent)))
(u/the-id collection))
(throw (Exception. (tru "You cannot move a Collection into itself or into one of its descendants."))))
(set
(cons (perms/collection-readwrite-path new-parent)
(perms-for-archiving collection)))) | |
Move a Collection and all its descendant Collections from its current | (mu/defn move-collection!
[collection :- CollectionWithLocationAndIDOrRoot, new-location :- LocationPath]
(let [orig-children-location (children-location collection)
new-children-location (children-location (assoc collection :location new-location))]
;; first move this Collection
(log/info (trs "Moving Collection {0} and its descendants from {1} to {2}"
(u/the-id collection) (:location collection) new-location))
(t2/with-transaction [_conn]
(t2/update! Collection (u/the-id collection) {:location new-location})
;; we need to update all the descendant collections as well...
(t2/query-one
{:update :collection
:set {:location [:replace :location orig-children-location new-children-location]}
:where [:like :location (str orig-children-location "%")]})))) |
(mu/defn ^:private collection->descendant-ids :- [:maybe [:set ms/PositiveInt]]
[collection :- CollectionWithLocationAndIDOrRoot, & additional-conditions]
(apply t2/select-pks-set Collection
:location [:like (str (children-location collection) "%")]
additional-conditions)) | |
Archive a Collection and its descendant Collections and their Cards, Dashboards, and Pulses. | (mu/defn ^:private archive-collection!
[collection :- CollectionWithLocationAndIDOrRoot]
(let [affected-collection-ids (cons (u/the-id collection)
(collection->descendant-ids collection, :archived false))]
(t2/with-transaction [_conn]
(t2/update! (t2/table-name Collection)
{:id [:in affected-collection-ids]
:archived false}
{:archived true})
(doseq [model '[Card Dashboard NativeQuerySnippet Pulse]]
(t2/update! model {:collection_id [:in affected-collection-ids]
:archived false}
{:archived true}))))) |
Unarchive a Collection and its descendant Collections and their Cards, Dashboards, and Pulses. | (mu/defn ^:private unarchive-collection!
[collection :- CollectionWithLocationAndIDOrRoot]
(let [affected-collection-ids (cons (u/the-id collection)
(collection->descendant-ids collection, :archived true))]
(t2/with-transaction [_conn]
(t2/update! (t2/table-name Collection)
{:id [:in affected-collection-ids]
:archived true}
{:archived false})
(doseq [model '[Card Dashboard NativeQuerySnippet Pulse]]
(t2/update! model {:collection_id [:in affected-collection-ids]
:archived true}
{:archived false}))))) |
+----------------------------------------------------------------------------------------------------------------+ | Toucan IModel & Perms Method Impls | +----------------------------------------------------------------------------------------------------------------+ | |
Schema for a Collection instance that has a valid | (def ^:private CollectionWithLocationAndPersonalOwnerID [:map [:location LocationPath] [:personal_owner_id [:maybe ms/PositiveInt]]]) |
(mu/defn is-personal-collection-or-descendant-of-one? :- :boolean
"Is `collection` a Personal Collection, or a descendant of one?"
[collection :- CollectionWithLocationAndPersonalOwnerID]
(boolean
(or
;; If collection has an owner ID we're already done here, we know it's a Personal Collection
(:personal_owner_id collection)
;; Otherwise try to get the ID of its highest-level ancestor, e.g. if `location` is `/1/2/3/` we would get `1`.
;; Then see if the root-level ancestor is a Personal Collection (Personal Collections can only got in the Root
;; Collection.)
(t2/exists? Collection
:id (first (location-path->ids (:location collection)))
:personal_owner_id [:not= nil])))) | |
----------------------------------------------------- INSERT ----------------------------------------------------- | |
(t2/define-before-insert :model/Collection
[{collection-name :name, :as collection}]
(assert-valid-location collection)
(assert-valid-namespace (merge {:namespace nil} collection))
(assoc collection :slug (slugify collection-name))) | |
Grant read permissions to destination Collections for every Group with read permissions for a source Collection, and write perms for every Group with write perms for the source Collection. | (defn- copy-collection-permissions!
[source-collection-or-id dest-collections-or-ids]
;; figure out who has permissions for the source Collection...
(let [group-ids-with-read-perms (t2/select-fn-set :group_id Permissions
:object (perms/collection-read-path source-collection-or-id))
group-ids-with-write-perms (t2/select-fn-set :group_id Permissions
:object (perms/collection-readwrite-path source-collection-or-id))]
;; ...and insert corresponding rows for each destination Collection
(t2/insert! Permissions
(concat
;; insert all the new read-perms records
(for [dest dest-collections-or-ids
:let [read-path (perms/collection-read-path dest)]
group-id group-ids-with-read-perms]
{:group_id group-id, :object read-path})
;; ...and all the new write-perms records
(for [dest dest-collections-or-ids
:let [readwrite-path (perms/collection-readwrite-path dest)]
group-id group-ids-with-write-perms]
{:group_id group-id, :object readwrite-path}))))) |
When creating a new Collection, we shall copy the Permissions entries for its parent. That way, Groups who can see its parent can see it; and Groups who can 'curate' (write) its parent can 'curate' it, as a default state. (Of course, admins can change these permissions after the fact.) This does not apply to Collections that are created inside a Personal Collection or one of its descendants. Descendants of Personal Collections, like Personal Collections themselves, cannot have permissions entries in the application database. For newly created Collections at the root-level, copy the existing permissions for the Root Collection. | (defn- copy-parent-permissions!
[{:keys [location id], collection-namespace :namespace, :as collection}]
(when-not (is-personal-collection-or-descendant-of-one? collection)
(let [parent-collection-id (location-path->parent-id location)]
(copy-collection-permissions! (or parent-collection-id (assoc root-collection :namespace collection-namespace))
[id])))) |
(t2/define-after-insert :model/Collection
[collection]
(u/prog1 collection
(copy-parent-permissions! (t2.realize/realize collection)))) | |
----------------------------------------------------- UPDATE ----------------------------------------------------- | |
If we're trying to UPDATE a Personal Collection, make sure the proposed changes are allowed. Personal Collections have lots of restrictions -- you can't archive them, for example, nor can you transfer them to other Users. | (mu/defn ^:private check-changes-allowed-for-personal-collection
[collection-before-updates :- CollectionWithLocationAndIDOrRoot
collection-updates :- :map]
;; you're not allowed to change the `:personal_owner_id` of a Collection!
;; double-check and make sure it's not just the existing value getting passed back in for whatever reason
(let [unchangeable {:personal_owner_id (tru "You are not allowed to change the owner of a Personal Collection.")
:authority_level (tru "You are not allowed to change the authority level of a Personal Collection.")
;; The checks below should be redundant because the `perms-for-moving` and `perms-for-archiving`
;; functions also check to make sure you're not operating on Personal Collections. But as an extra safety net it
;; doesn't hurt to check here too.
:location (tru "You are not allowed to move a Personal Collection.")
:archived (tru "You cannot archive a Personal Collection.")}]
(when-let [[k msg] (->> unchangeable
(filter (fn [[k _msg]]
(api/column-will-change? k collection-before-updates collection-updates)))
first)]
(throw
(ex-info msg {:status-code 400 :errors {k msg}}))))) |
If | (mu/defn ^:private maybe-archive-or-unarchive!
[collection-before-updates :- CollectionWithLocationAndIDOrRoot
collection-updates :- :map]
;; If the updates map contains a value for `:archived`, see if it's actually something different than current value
(when (api/column-will-change? :archived collection-before-updates collection-updates)
;; check to make sure we're not trying to change location at the same time
(when (api/column-will-change? :location collection-before-updates collection-updates)
(throw (ex-info (tru "You cannot move a Collection and archive it at the same time.")
{:status-code 400
:errors {:archived (tru "You cannot move a Collection and archive it at the same time.")}})))
;; ok, go ahead and do the archive/unarchive operation
((if (:archived collection-updates)
archive-collection!
unarchive-collection!) collection-before-updates))) |
MOVING COLLECTIONS ACROSS "PERSONAL" BOUNDARIES As mentioned elsewhere, Permissions for Collections are handled in two different, incompatible, ways, depending on whether or not the Collection is a descendant of a Personal Collection:
Thus, When a Collection moves "across the boundary" and either becomes a descendant of a Personal Collection, or ceases to be one, we need to take steps to transition it so it plays nicely with the new way Permissions will apply to it. The steps taken in each direction are explained in more detail for in the docstrings of their respective implementing functions below. | |
When moving a descendant of a Personal Collection into the Root Collection, or some other Collection not descended from a Personal Collection, we need to grant it Permissions, since now that it has moved across the boundary into impersonal-land it requires Permissions to be seen or 'curated'. If we did not grant Permissions when moving, it would immediately become invisible to all save admins, because no Group would have perms for it. This is obviously a bad experience -- we do not want a User to move a Collection that they have read/write perms for (by definition) to somewhere else and lose all access for it. | (mu/defn ^:private grant-perms-when-moving-out-of-personal-collection!
[collection :- (mi/InstanceOf Collection) new-location :- LocationPath]
(copy-collection-permissions! (parent {:location new-location}) (cons collection (descendants collection)))) |
When moving a This needs to be done recursively for all descendants as well. | (mu/defn ^:private revoke-perms-when-moving-into-personal-collection!
[collection :- (mi/InstanceOf Collection)]
(t2/query-one {:delete-from :permissions
:where [:in :object (for [collection (cons collection (descendants collection))
path-fn [perms/collection-read-path
perms/collection-readwrite-path]]
(path-fn collection))]})) |
If a Collection is moving 'across the boundry' and will become a descendant of a Personal Collection, or will cease to be one, adjust the Permissions for it accordingly. | (defn- update-perms-when-moving-across-personal-boundry!
[collection-before-updates collection-updates]
;; first, figure out if the collection is a descendant of a Personal Collection now, and whether it will be after
;; the update
(let [is-descendant-of-personal? (is-personal-collection-or-descendant-of-one? collection-before-updates)
will-be-descendant-of-personal? (is-personal-collection-or-descendant-of-one? (merge collection-before-updates
collection-updates))]
;; see if whether it is a descendant of a Personal Collection or not is set to change. If it's not going to
;; change, we don't need to do anything
(when (not= is-descendant-of-personal? will-be-descendant-of-personal?)
;; if it *is* a descendant of a Personal Collection, and is about to be moved into the 'real world', we need to
;; copy the new parent's perms for it and for all of its descendants
(if is-descendant-of-personal?
(grant-perms-when-moving-out-of-personal-collection! collection-before-updates (:location collection-updates))
;; otherwise, if it is *not* a descendant of a Personal Collection, but is set to become one, we need to
;; delete any perms entries for it and for all of its descendants, so other randos won't be able to access
;; this newly privatized Collection
(revoke-perms-when-moving-into-personal-collection! collection-before-updates))))) |
PUTTING IT ALL TOGETHER <3 | |
Returns true if the :namespace values (for a collection) are equal between multiple instances. Either one can be a string or keyword. This is necessary because on select, the :namespace value becomes a keyword (and hence, is a keyword in | (defn- namespace-equals?
[& namespaces]
(let [std-fn (fn [v]
(if (keyword? v) (name v) (str v)))]
(apply = (map std-fn namespaces)))) |
(t2/define-before-update :model/Collection
[collection]
(let [collection-before-updates (t2/instance :model/Collection (t2/original collection))
{collection-name :name
:as collection-updates} (or (t2/changes collection) {})]
;; VARIOUS CHECKS BEFORE DOING ANYTHING:
;; (1) if this is a personal Collection, check that the 'propsed' changes are allowed
(when (:personal_owner_id collection-before-updates)
(check-changes-allowed-for-personal-collection collection-before-updates collection-updates))
;; (2) make sure the location is valid if we're changing it
(assert-valid-location collection-updates)
;; (3) make sure Collection namespace is valid
(when (contains? collection-updates :namespace)
(when-not (namespace-equals? (:namespace collection-before-updates) (:namespace collection-updates))
(let [msg (tru "You cannot move a Collection to a different namespace once it has been created.")]
(throw (ex-info msg {:status-code 400, :errors {:namespace msg}})))))
(assert-valid-namespace (merge (select-keys collection-before-updates [:namespace]) collection-updates))
;; (4) If we're moving a Collection from a location on a Personal Collection hierarchy to a location not on one,
;; or vice versa, we need to grant/revoke permissions as appropriate (see above for more details)
(when (api/column-will-change? :location collection-before-updates collection-updates)
(update-perms-when-moving-across-personal-boundry! collection-before-updates collection-updates))
;; OK, AT THIS POINT THE CHANGES ARE VALIDATED. NOW START ISSUING UPDATES
;; (1) archive or unarchive as appropriate
(maybe-archive-or-unarchive! collection-before-updates collection-updates)
;; (2) slugify the collection name in case it's changed in the output; the results of this will get passed along
;; to Toucan's `update!` impl
(cond-> collection-updates
collection-name (assoc :slug (slugify collection-name))))) | |
----------------------------------------------------- DELETE ----------------------------------------------------- | |
Whether to allow deleting Personal Collections. Normally we should never allow this, but
in the single case of deleting a User themselves, we need to allow this. (Note that in normal usage, Users never get
deleted, but rather archived; thus this code is used solely by our test suite, by things such as the | (defonce ^:dynamic *allow-deleting-personal-collections* false) |
(t2/define-before-delete :model/Collection
[collection]
;; Delete all the Children of this Collection
(t2/delete! Collection :location (children-location collection))
;; You can't delete a Personal Collection! Unless we enable it because we are simultaneously deleting the User
(when-not *allow-deleting-personal-collections*
(when (:personal_owner_id collection)
(throw (Exception. (tru "You cannot delete a Personal Collection!")))))
;; Delete permissions records for this Collection
(t2/query-one {:delete-from :permissions
:where [:or
[:= :object (perms/collection-readwrite-path collection)]
[:= :object (perms/collection-read-path collection)]]})) | |
-------------------------------------------------- IModel Impl --------------------------------------------------- | |
Return the required set of permissions to | (defmethod mi/perms-objects-set Collection
[collection-or-id read-or-write]
(let [collection (if (integer? collection-or-id)
(t2/select-one [Collection :id :namespace] :id (collection-or-id))
collection-or-id)]
;; HACK Collections in the "snippets" namespace have no-op permissions unless EE enhancements are enabled
;;
;; TODO -- Pretty sure snippet perms should be feature flagged by `advanced-permissions` instead
(if (and (= (u/qualified-name (:namespace collection)) "snippets")
(not (premium-features/enable-enhancements?)))
#{}
;; This is not entirely accurate as you need to be a superuser to modifiy a collection itself (e.g., changing its
;; name) but if you have write perms you can add/remove cards
#{(case read-or-write
:read (perms/collection-read-path collection-or-id)
:write (perms/collection-readwrite-path collection-or-id))}))) |
(defn- parent-identity-hash [coll]
(let [parent-id (-> coll
(t2/hydrate :parent_id)
:parent_id)]
(if parent-id
(serdes/identity-hash (t2/select-one Collection :id parent-id))
"ROOT"))) | |
(defmethod serdes/hash-fields Collection [_collection] [:name :namespace parent-identity-hash :created_at]) | |
(defmethod serdes/extract-query "Collection" [_model {:keys [collection-set]}]
(if (seq collection-set)
(t2/reducible-select Collection :id [:in collection-set])
(t2/reducible-select Collection :personal_owner_id nil))) | |
(defmethod serdes/extract-one "Collection"
;; Transform :location (which uses database IDs) into a portable :parent_id with the parent's entity ID.
;; Also transform :personal_owner_id from a database ID to the email string, if it's defined.
;; Use the :slug as the human-readable label.
[_model-name _opts coll]
(let [fetch-collection (fn [id]
(t2/select-one Collection :id id))
parent (some-> coll
:id
fetch-collection
(t2/hydrate :parent_id)
:parent_id
fetch-collection)
parent-id (when parent
(or (:entity_id parent) (serdes/identity-hash parent)))
owner-email (when (:personal_owner_id coll)
(t2/select-one-fn :email 'User :id (:personal_owner_id coll)))]
(-> (serdes/extract-one-basics "Collection" coll)
(dissoc :location)
(assoc :parent_id parent-id :personal_owner_id owner-email)
(assoc-in [:serdes/meta 0 :label] (:slug coll))))) | |
(defmethod serdes/load-xform "Collection" [{:keys [parent_id] :as contents}]
(let [loc (if parent_id
(let [{:keys [id location]} (serdes/lookup-by-id Collection parent_id)]
(str location id "/"))
"/")]
(-> contents
(dissoc :parent_id)
(assoc :location loc)
(update :personal_owner_id serdes/*import-user*)
serdes/load-xform-basics))) | |
(defmethod serdes/dependencies "Collection"
[{:keys [parent_id]}]
(if parent_id
[[{:model "Collection" :id parent_id}]]
[])) | |
(defmethod serdes/generate-path "Collection" [_ coll] (serdes/maybe-labeled "Collection" coll :slug)) | |
(defmethod serdes/ascendants "Collection" [_ id]
(let [location (t2/select-one-fn :location Collection :id id)]
;; it would work returning just one, but why not return all if it's cheap
(set (map vector (repeat "Collection") (location-path->ids location))))) | |
(defmethod serdes/descendants "Collection" [_model-name id]
(let [location (t2/select-one-fn :location Collection :id id)
child-colls (set (for [child-id (t2/select-pks-set Collection {:where [:like :location (str location id "/%")]})]
["Collection" child-id]))
dashboards (set (for [dash-id (t2/select-pks-set 'Dashboard :collection_id id)]
["Dashboard" dash-id]))
cards (set (for [card-id (t2/select-pks-set 'Card :collection_id id)]
["Card" card-id]))]
(set/union child-colls dashboards cards))) | |
(defmethod serdes/storage-path "Collection" [coll {:keys [collections]}]
(let [parental (get collections (:entity_id coll))]
(concat ["collections"] parental [(last parental)]))) | |
+----------------------------------------------------------------------------------------------------------------+ | Perms Checking Helper Fns | +----------------------------------------------------------------------------------------------------------------+ | |
Check that we have write permissions for Collection with | (defn check-write-perms-for-collection
[collection-or-id-or-nil]
(let [actual-perms @*current-user-permissions-set*
required-perms (perms/collection-readwrite-path (if collection-or-id-or-nil
collection-or-id-or-nil
root-collection))]
(when-not (perms/set-has-full-permissions? actual-perms required-perms)
(throw (ex-info (tru "You do not have curate permissions for this Collection.")
{:status-code 403
:collection collection-or-id-or-nil
:required-perms required-perms
:actual-perms actual-perms}))))) |
If we're changing the As usual, an Intended for use with ;; | (defn check-allowed-to-change-collection
[object-before-update object-updates]
;; if collection_id is set to change...
(when (api/column-will-change? :collection_id object-before-update object-updates)
;; check that we're allowed to modify the old Collection
(check-write-perms-for-collection (:collection_id object-before-update))
;; check that we're allowed to modify the new Collection
(check-write-perms-for-collection (:collection_id object-updates)))) |
+----------------------------------------------------------------------------------------------------------------+ | Personal Collections | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn format-personal-collection-name :- ms/NonBlankString
"Constructs the personal collection name from user name.
When displaying to users we'll tranlsate it to user's locale,
but to keeps things consistent in the database, we'll store the name in site's locale.
Practically, use `user-or-site` = `:site` when insert or update the name in database,
and `:user` when we need the name for displaying purposes"
[first-name last-name email user-or-site]
{:pre [(#{:user :site} user-or-site)]}
(if (= :user user-or-site)
(cond
(and first-name last-name) (tru "{0} {1}''s Personal Collection" first-name last-name)
:else (tru "{0}''s Personal Collection" (or first-name last-name email)))
(cond
(and first-name last-name) (trs "{0} {1}''s Personal Collection" first-name last-name)
:else (trs "{0}''s Personal Collection" (or first-name last-name email))))) | |
(mu/defn user->personal-collection-name :- ms/NonBlankString
"Come up with a nice name for the Personal Collection for `user-or-id`."
[user-or-id user-or-site]
(let [{first-name :first_name
last-name :last_name
email :email} (t2/select-one ['User :first_name :last_name :email]
:id (u/the-id user-or-id))]
(format-personal-collection-name first-name last-name email user-or-site))) | |
For Personal collection, we make sure the collection's name and slug is translated to user's locale This is only used for displaying purposes, For insertion or updating the name, use site's locale instead | (defn personal-collection-with-ui-details
[{:keys [personal_owner_id] :as collection}]
(if-not personal_owner_id
collection
(let [collection-name (user->personal-collection-name personal_owner_id :user)]
(assoc collection
:name collection-name
:slug (u/slugify collection-name))))) |
(mu/defn user->existing-personal-collection :- [:maybe (mi/InstanceOf Collection)] "For a `user-or-id`, return their personal Collection, if it already exists. Use [[metabase.models.collection/user->personal-collection]] to fetch their personal Collection *and* create it if needed." [user-or-id] (t2/select-one Collection :personal_owner_id (u/the-id user-or-id))) | |
(mu/defn user->personal-collection :- (mi/InstanceOf Collection)
"Return the Personal Collection for `user-or-id`, if it already exists; if not, create it and return it."
[user-or-id]
(or (user->existing-personal-collection user-or-id)
(try
(first (t2/insert-returning-instances! Collection
{:name (user->personal-collection-name user-or-id :site)
:personal_owner_id (u/the-id user-or-id)}))
;; if an Exception was thrown why trying to create the Personal Collection, we can assume it was a race
;; condition where some other thread created it in the meantime; try one last time to fetch it
(catch Throwable e
(or (user->existing-personal-collection user-or-id)
(throw e)))))) | |
Cached function to fetch the ID of the Personal Collection belonging to User with | (def ^:private ^{:arglists '([user-id])} user->personal-collection-id
(memoize/ttl
^{::memoize/args-fn (fn [[user-id]]
[(mdb.connection/unique-identifier) user-id])}
(fn user->personal-collection-id*
[user-id]
(u/the-id (user->personal-collection user-id)))
;; cache the results for 60 minutes; TTL is here only to eventually clear out old entries/keep it from growing too
;; large
:ttl/threshold (* 60 60 1000))) |
(mu/defn user->personal-collection-and-descendant-ids :- [:sequential {:min 1} ms/PositiveInt]
"Somewhat-optimized function that fetches the ID of a User's Personal Collection as well as the IDs of all descendants
of that Collection. Exists because this needs to be known to calculate the Current User's permissions set, which is
done for every API call; this function is an attempt to make fetching this information as efficient as reasonably
possible."
[user-or-id]
(let [personal-collection-id (user->personal-collection-id (u/the-id user-or-id))]
(cons personal-collection-id
;; `descendant-ids` wants a CollectionWithLocationAndID, and luckily we know Personal Collections always go
;; in Root, so we can pass it what it needs without actually having to fetch an entire CollectionInstance
(descendant-ids {:location "/", :id personal-collection-id})))) | |
(mi/define-batched-hydration-method include-personal-collection-ids
:personal_collection_id
"Efficiently hydrate the `:personal_collection_id` property of a sequence of Users. (This is, predictably, the ID of
their Personal Collection.)"
[users]
(when (seq users)
;; efficiently create a map of user ID -> personal collection ID
(let [user-id->collection-id (t2/select-fn->pk :personal_owner_id Collection
:personal_owner_id [:in (set (map u/the-id users))])]
(assert (map? user-id->collection-id))
;; now for each User, try to find the corresponding ID out of that map. If it's not present (the personal
;; Collection hasn't been created yet), then instead call `user->personal-collection-id`, which will create it
;; as a side-effect. This will ensure this property never comes back as `nil`
(for [user users]
(assoc user :personal_collection_id (or (user-id->collection-id (u/the-id user))
(user->personal-collection-id (u/the-id user)))))))) | |
(mi/define-batched-hydration-method collection-is-personal
:is_personal
"Efficiently hydrate the `:is_personal` property of a sequence of Collections.
`true` means the collection is or nested in a personal collection."
[collections]
(if (= 1 (count collections))
(let [collection (first collections)]
(if (some? collection)
[(assoc collection :is_personal (is-personal-collection-or-descendant-of-one? collection))]
;; root collection is nil
[collection]))
(let [personal-collection-ids (t2/select-pks-set :model/collection :personal_owner_id [:not= nil])
location-is-personal (fn [location]
(boolean
(and (string? location)
(some #(str/starts-with? location (format "/%d/" %)) personal-collection-ids))))]
(map (fn [{:keys [location personal_owner_id] :as coll}]
(if (some? coll)
(assoc coll :is_personal (or (some? personal_owner_id)
(location-is-personal location)))
nil))
collections)))) | |
Set of Collection namespaces (as keywords) that instances of this model are allowed to go in. By default, only the
default namespace (namespace = | (defmulti allowed-namespaces
{:arglists '([model])}
t2.protocols/dispatch-value) |
(defmethod allowed-namespaces :default
[_]
#{nil :analytics}) | |
Check that object's ;; Cards can only go in Collections in the default namespace (namespace = nil) (check-collection-namespace Card new-collection-id) | (defn check-collection-namespace
[model collection-id]
(when collection-id
(let [collection (or (t2/select-one [Collection :namespace] :id collection-id)
(let [msg (tru "Collection does not exist.")]
(throw (ex-info msg {:status-code 404
:errors {:collection_id msg}}))))
collection-namespace (keyword (:namespace collection))
allowed-namespaces (allowed-namespaces model)]
(when-not (contains? allowed-namespaces collection-namespace)
(let [msg (tru "A {0} can only go in Collections in the {1} namespace."
(name model)
(str/join (format " %s " (tru "or")) (map #(pr-str (or % (tru "default")))
allowed-namespaces)))]
(throw (ex-info msg {:status-code 400
:errors {:collection_id msg}
:allowed-namespaces allowed-namespaces
:collection-namespace collection-namespace}))))))) |
Annotate collections with | (defn- annotate-collections
[{:keys [dataset card] :as _coll-type-ids} collections]
(let [parent-info (reduce (fn [m {:keys [location id] :as _collection}]
(let [parent-ids (set (location-path->ids location))]
(cond-> m
(contains? dataset id)
(update :dataset set/union parent-ids)
(contains? card id)
(update :card set/union parent-ids))))
{:dataset #{} :card #{}}
collections)]
(map (fn [{:keys [id] :as collection}]
(let [types (cond-> #{}
(contains? (:dataset parent-info) id)
(conj :dataset)
(contains? (:card parent-info) id)
(conj :card))]
(cond-> collection
(seq types) (assoc :below types)
(contains? dataset id) (update :here (fnil conj #{}) :dataset)
(contains? card id) (update :here (fnil conj #{}) :card))))
collections))) |
Convert a flat sequence of Collections into a tree structure e.g. (collections->tree {:dataset #{C D} :card #{F C} [A B C D E F G]) ;; -> [{:name "A" :below #{:card :dataset} :children [{:name "B"} {:name "C" :here #{:dataset :card} :below #{:dataset :card} :children [{:name "D" :here #{:dataset} :children [{:name "E"}]} {:name "F" :here #{:card} :children [{:name "G"}]}]}]} {:name "H"}] | (defn collections->tree
[coll-type-ids collections]
(let [all-visible-ids (set (map :id collections))]
(transduce
identity
(fn ->tree
;; 1. We'll use a map representation to start off with to make building the tree easier. Keyed by Collection ID
;; e.g.
;;
;; {1 {:name "A"
;; :children {2 {:name "B"}, ...}}}
([] {})
;; 2. For each as we come across it, put it in the correct location in the tree. Convert it's `:location` (e.g.
;; `/1/`) plus its ID to a key path e.g. `[1 :children 2]`
;;
;; If any ancestor Collections are not present in `collections`, just remove their IDs from the path,
;; effectively "pulling" a Collection up to a higher level. e.g. if we have A > B > C and we can't see B then
;; the tree should come back as A > C.
([m collection]
(let [path (as-> (location-path->ids (:location collection)) ids
(filter all-visible-ids ids)
(concat ids [(:id collection)])
(interpose :children ids))]
(update-in m path merge collection)))
;; 3. Once we've build the entire tree structure, go in and convert each ID->Collection map into a flat sequence,
;; sorted by the lowercased Collection name. Do this recursively for the `:children` of each Collection e.g.
;;
;; {1 {:name "A"
;; :children {2 {:name "B"}, ...}}}
;; ->
;; [{:name "A"
;; :children [{:name "B"}, ...]}]
([m]
(->> (vals m)
(map #(update % :children ->tree))
(sort-by (fn [{coll-type :type, coll-name :name, coll-id :id}]
;; coll-type is `nil` or "instance-analytics"
;; nil sorts first, so we get instance-analytics at the end, which is what we want
[coll-type ((fnil u/lower-case-en "") coll-name) coll-id])))))
(annotate-collections coll-type-ids collections)))) |
(ns metabase.models.collection-permission-graph-revision (:require [metabase.models.interface :as mi] [metabase.util.i18n :refer [tru]] [methodical.core :as methodical] [toucan2.core :as t2])) | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase. | (def CollectionPermissionGraphRevision :model/CollectionPermissionGraphRevision) |
(methodical/defmethod t2/table-name :model/CollectionPermissionGraphRevision [_model] :collection_permission_graph_revision) | |
(doto :model/CollectionPermissionGraphRevision (derive :metabase/model) (derive :hook/created-at-timestamped?)) | |
(t2/deftransforms :model/CollectionPermissionGraphRevision
{:before mi/transform-json
:after mi/transform-json}) | |
(t2/define-before-update :model/CollectionPermissionGraphRevision [_] (throw (Exception. (tru "You cannot update a CollectionPermissionGraphRevision!")))) | |
Return the ID of the newest | (defn latest-id
[]
(or (:id (t2/select-one [CollectionPermissionGraphRevision [:%max.id :id]]))
0)) |
Code for generating and updating the Collection permissions graph. See [[metabase.models.permissions]] for more details and for the code for generating and updating the data permissions graph. | (ns metabase.models.collection.graph
(:require
[clojure.data :as data]
[metabase.db.query :as mdb.query]
[metabase.models.collection :as collection :refer [Collection]]
[metabase.models.collection-permission-graph-revision
:as c-perm-revision
:refer [CollectionPermissionGraphRevision]]
[metabase.models.permissions :as perms :refer [Permissions]]
[metabase.models.permissions-group :as perms-group :as perms-group :refer [PermissionsGroup]]
[metabase.public-settings.premium-features :refer [defenterprise]]
[metabase.util :as u]
[metabase.util.honey-sql-2 :as h2x]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[toucan2.core :as t2])) |
+----------------------------------------------------------------------------------------------------------------+ | PERMISSIONS GRAPH | +----------------------------------------------------------------------------------------------------------------+ | |
---------------------------------------------------- Schemas ----------------------------------------------------- | |
(def ^:private CollectionPermissions [:enum :write :read :none]) | |
collection-id -> status | (def ^:private GroupPermissionsGraph ; when doing a delta between old graph and new graph root won't always ; be present, which is why it's *optional* [:map-of [:or [:= :root] ms/PositiveInt] CollectionPermissions]) |
(def ^:private PermissionsGraph
[:map {:closed true}
[:revision :int]
[:groups [:map-of ms/PositiveInt GroupPermissionsGraph]]]) | |
-------------------------------------------------- Fetch Graph --------------------------------------------------- | |
(defn- group-id->permissions-set []
(into {} (for [[group-id perms] (group-by :group_id (t2/select Permissions))]
{group-id (set (map :object perms))}))) | |
(mu/defn ^:private perms-type-for-collection :- CollectionPermissions
[permissions-set collection-or-id]
(cond
(perms/set-has-full-permissions? permissions-set (perms/collection-readwrite-path collection-or-id)) :write
(perms/set-has-full-permissions? permissions-set (perms/collection-read-path collection-or-id)) :read
:else :none)) | |
(mu/defn ^:private group-permissions-graph :- GroupPermissionsGraph
"Return the permissions graph for a single group having `permissions-set`."
[collection-namespace permissions-set collection-ids]
(into
{:root (perms-type-for-collection permissions-set (assoc collection/root-collection :namespace collection-namespace))}
(for [collection-id collection-ids]
{collection-id (perms-type-for-collection permissions-set collection-id)}))) | |
(mu/defn ^:private non-personal-collection-ids :- [:set ms/PositiveInt]
"Return a set of IDs of all Collections that are neither Personal Collections nor descendants of Personal
Collections (i.e., things that you can set Permissions for, and that should go in the graph.)"
[collection-namespace :- [:maybe ms/KeywordOrString]]
(let [personal-collection-ids (t2/select-pks-set Collection :personal_owner_id [:not= nil])
honeysql-form {:select [[:id :id]]
:from [:collection]
:where (into [:and
(perms/audit-namespace-clause :namespace (u/qualified-name collection-namespace))
[:= :personal_owner_id nil]]
(for [collection-id personal-collection-ids]
[:not [:like :location (h2x/literal (format "/%d/%%" collection-id))]]))}]
(set (map :id (mdb.query/query honeysql-form))))) | |
Return the permission graph for the collections with id in | (defn- collection-permission-graph
([collection-ids] (collection-permission-graph collection-ids nil))
([collection-ids collection-namespace]
(let [group-id->perms (group-id->permissions-set)]
{:revision (c-perm-revision/latest-id)
:groups (into {} (for [group-id (t2/select-pks-set PermissionsGroup)]
{group-id (group-permissions-graph collection-namespace
(group-id->perms group-id)
collection-ids)}))}))) |
In the graph, override the instance analytics collection within the admin group to read. | (defn- modify-instance-analytics-for-admins
[graph]
(let [admin-group-id (:id (perms-group/admin))
audit-collection-id (:id (perms/default-audit-collection))]
(if (nil? audit-collection-id)
graph
(assoc-in graph [:groups admin-group-id audit-collection-id] :read)))) |
(mu/defn graph :- PermissionsGraph
"Fetch a graph representing the current permissions status for every group and all permissioned collections. This
works just like the function of the same name in `metabase.models.permissions`; see also the documentation for that
function.
The graph is restricted to a given namespace by the optional `collection-namespace` param; by default, `nil`, which
restricts it to the 'default' namespace containing normal Card/Dashboard/Pulse Collections.
Note: All Collections are returned at the same level of the 'graph', regardless of how the Collection hierarchy is
structured. Collections do not inherit permissions from ancestor Collections in the same way data permissions are
inherited (e.g. full `:read` perms for a Database implies `:read` perms for all its schemas); a 'child' object (e.g.
schema) *cannot* have more restrictive permissions than its parent (e.g. Database). Child Collections *can* have
more restrictive permissions than their parent."
([]
(graph nil))
([collection-namespace :- [:maybe ms/KeywordOrString]]
(t2/with-transaction [_conn]
(-> collection-namespace
non-personal-collection-ids
(collection-permission-graph collection-namespace)
modify-instance-analytics-for-admins)))) | |
-------------------------------------------------- Update Graph -------------------------------------------------- | |
Update the permissions for group ID with | (mu/defn ^:private update-collection-permissions!
[collection-namespace :- [:maybe ms/KeywordOrString]
group-id :- ms/PositiveInt
collection-id :- [:or [:= :root] ms/PositiveInt]
new-collection-perms :- CollectionPermissions]
(let [collection-id (if (= collection-id :root)
(assoc collection/root-collection :namespace collection-namespace)
collection-id)]
;; remove whatever entry is already there (if any) and add a new entry if applicable
(perms/revoke-collection-permissions! group-id collection-id)
(case new-collection-perms
:write (perms/grant-collection-readwrite-permissions! group-id collection-id)
:read (perms/grant-collection-read-permissions! group-id collection-id)
:none nil))) |
(mu/defn ^:private update-group-permissions!
[collection-namespace :- [:maybe ms/KeywordOrString]
group-id :- ms/PositiveInt
new-group-perms :- GroupPermissionsGraph]
(doseq [[collection-id new-perms] new-group-perms]
(update-collection-permissions! collection-namespace group-id collection-id new-perms))) | |
OSS implementation of | (defenterprise update-audit-collection-permissions! metabase-enterprise.audit-app.permissions [_ _] ::noop) |
Update the Collections permissions graph for Collections of | (mu/defn update-graph!
([new-graph]
(update-graph! nil new-graph))
([collection-namespace :- [:maybe ms/KeywordOrString], new-graph :- PermissionsGraph]
(let [old-graph (graph collection-namespace)
old-perms (:groups old-graph)
new-perms (:groups new-graph)
;; filter out any groups not in the old graph
new-perms (select-keys new-perms (keys old-perms))
;; filter out any collections not in the old graph
new-perms (into {} (for [[group-id collection-id->perms] new-perms]
[group-id (select-keys collection-id->perms (keys (get old-perms group-id)))]))
[diff-old changes] (data/diff old-perms new-perms)]
(perms/log-permissions-changes diff-old changes)
(perms/check-revision-numbers old-graph new-graph)
(when (seq changes)
(t2/with-transaction [_conn]
(doseq [[group-id changes] changes]
(update-audit-collection-permissions! group-id changes)
(update-group-permissions! collection-namespace group-id changes))
(perms/save-perms-revision! CollectionPermissionGraphRevision (:revision old-graph)
(assoc old-graph :namespace collection-namespace) changes)))))) |
(ns metabase.models.collection.root (:require [medley.core :as m] [metabase.models.interface :as mi] [metabase.models.permissions :as perms] [metabase.public-settings.premium-features :as premium-features] [metabase.shared.util.i18n :refer [tru]] [metabase.util :as u] [potemkin.types :as p.types] [toucan2.protocols :as t2.protocols] [toucan2.tools.hydrate :refer [hydrate]])) | |
+----------------------------------------------------------------------------------------------------------------+ | Root Collection Special Placeholder Object | +----------------------------------------------------------------------------------------------------------------+ | |
The Root Collection special placeholder object is used to represent the fact that we're working with the 'Root' Collection in many of the functions in this namespace. The Root Collection is not a true Collection, but instead represents things that have no collection_id, or are otherwise to be seen at the top-level by the current user. | |
(p.types/defrecord+ RootCollection []) | |
(doto RootCollection (derive ::mi/read-policy.full-perms-for-perms-set) (derive ::mi/write-policy.full-perms-for-perms-set)) | |
(extend-protocol t2.protocols/IModel
RootCollection
(model [_this]
RootCollection)) | |
(defmethod mi/perms-objects-set RootCollection
[collection read-or-write]
{:pre [(map? collection)]}
;; HACK Collections in the "snippets" namespace have no-op permissions unless EE enhancements are enabled
(if (and (= (u/qualified-name (:namespace collection)) "snippets")
(not (premium-features/enable-enhancements?)))
#{}
#{((case read-or-write
:read perms/collection-read-path
:write perms/collection-readwrite-path) collection)})) | |
Special placeholder object representing the Root Collection, which isn't really a real Collection. | (def ^RootCollection root-collection
(map->RootCollection {::is-root? true, :authority_level nil})) |
Is | (defn is-root-collection? [x] ;; TODO -- not sure this makes sense because other places we check whether `::is-root?` is present or not. (instance? RootCollection x)) |
The special Root Collection placeholder object with some extra details to facilitate displaying it on the FE. | (defn root-collection-with-ui-details
[collection-namespace]
(m/assoc-some root-collection
:name (case (keyword collection-namespace)
:snippets (tru "Top folder")
(tru "Our analytics"))
:namespace collection-namespace
:is_personal false
:id "root")) |
(defn- hydrated-root-collection
[]
(-> (root-collection-with-ui-details nil)
(hydrate :can_write))) | |
Hydrate | (defn hydrate-root-collection
[{:keys [collection_id] :as entity}]
(cond-> entity
(nil? collection_id) (assoc :collection (hydrated-root-collection)))) |
(ns metabase.models.dashboard
(:require
[clojure.core.async :as a]
[clojure.data :refer [diff]]
[clojure.set :as set]
[clojure.string :as str]
[medley.core :as m]
[metabase.automagic-dashboards.populate :as populate]
[metabase.db.query :as mdb.query]
[metabase.events :as events]
[metabase.models.audit-log :as audit-log]
[metabase.models.card :as card :refer [Card]]
[metabase.models.collection :as collection :refer [Collection]]
[metabase.models.dashboard-card
:as dashboard-card
:refer [DashboardCard]]
[metabase.models.dashboard-tab :as dashboard-tab]
[metabase.models.field-values :as field-values]
[metabase.models.interface :as mi]
[metabase.models.parameter-card :as parameter-card]
[metabase.models.params :as params]
[metabase.models.permissions :as perms]
[metabase.models.pulse :as pulse :refer [Pulse]]
[metabase.models.pulse-card :as pulse-card]
[metabase.models.revision :as revision]
[metabase.models.serialization :as serdes]
[metabase.moderation :as moderation]
[metabase.public-settings :as public-settings]
[metabase.query-processor.async :as qp.async]
[metabase.util :as u]
[metabase.util.i18n :as i18n :refer [deferred-tru deferred-trun tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[methodical.core :as methodical]
[toucan2.core :as t2]
[toucan2.realize :as t2.realize])) | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all the Dashboard symbol in our codebase. | (def Dashboard :model/Dashboard) |
(methodical/defmethod t2/table-name :model/Dashboard [_model] :report_dashboard) | |
(doto :model/Dashboard (derive :metabase/model) (derive ::perms/use-parent-collection-perms) (derive :hook/timestamped?) (derive :hook/entity-id)) | |
(defmethod mi/can-write? Dashboard
([instance]
;; Dashboards in audit collection should be read only
(if (and
;; We want to make sure there's an existing audit collection before doing the equality check below.
;; If there is no audit collection, this will be nil:
(some? (:id (perms/default-audit-collection)))
;; Is a direct descendant of audit collection
(= (:collection_id instance) (:id (perms/default-audit-collection))))
false
(mi/current-user-has-full-permissions? (perms/perms-objects-set-for-parent-collection instance :write))))
([_ pk]
(mi/can-write? (t2/select-one :model/Dashboard :id pk)))) | |
(defmethod mi/can-read? Dashboard ([instance] (perms/can-read-audit-helper :model/Dashboard instance)) ([_ pk] (mi/can-read? (t2/select-one :model/Dashboard :id pk)))) | |
(t2/deftransforms :model/Dashboard
{:parameters mi/transform-parameters-list
:embedding_params mi/transform-json}) | |
(t2/define-before-delete :model/Dashboard
[dashboard]
(let [dashboard-id (u/the-id dashboard)]
(parameter-card/delete-all-for-parameterized-object! "dashboard" dashboard-id)
(t2/delete! 'Revision :model "Dashboard" :model_id dashboard-id))) | |
(t2/define-before-insert :model/Dashboard
[dashboard]
(let [defaults {:parameters []}
dashboard (merge defaults dashboard)]
(u/prog1 dashboard
(params/assert-valid-parameters dashboard)
(collection/check-collection-namespace Dashboard (:collection_id dashboard))))) | |
(t2/define-after-insert :model/Dashboard
[dashboard]
(u/prog1 dashboard
(parameter-card/upsert-or-delete-from-parameters! "dashboard" (:id dashboard) (:parameters dashboard)))) | |
(t2/define-before-update :model/Dashboard
[dashboard]
(u/prog1 dashboard
(params/assert-valid-parameters dashboard)
(parameter-card/upsert-or-delete-from-parameters! "dashboard" (:id dashboard) (:parameters dashboard))
(collection/check-collection-namespace Dashboard (:collection_id dashboard)))) | |
Updates the pulses' names and collection IDs, and syncs the PulseCards | (defn- update-dashboard-subscription-pulses!
[dashboard]
(let [dashboard-id (u/the-id dashboard)
affected (mdb.query/query
{:select-distinct [[:p.id :pulse-id] [:pc.card_id :card-id]]
:from [[:pulse :p]]
:join [[:pulse_card :pc] [:= :p.id :pc.pulse_id]]
:where [:= :p.dashboard_id dashboard-id]})]
(when-let [pulse-ids (seq (distinct (map :pulse-id affected)))]
(let [correct-card-ids (->> (mdb.query/query
{:select-distinct [:dc.card_id]
:from [[:report_dashboardcard :dc]]
:where [:and
[:= :dc.dashboard_id dashboard-id]
[:not= :dc.card_id nil]]})
(map :card_id)
set)
stale-card-ids (->> affected
(keep :card-id)
set)
cards-to-add (set/difference correct-card-ids stale-card-ids)
card-id->dashcard-id (when (seq cards-to-add)
(t2/select-fn->pk :card_id DashboardCard :dashboard_id dashboard-id
:card_id [:in cards-to-add]))
positions-for (fn [pulse-id] (drop (pulse-card/next-position-for pulse-id)
(range)))
new-pulse-cards (for [pulse-id pulse-ids
[[card-id dashcard-id] position] (map vector
card-id->dashcard-id
(positions-for pulse-id))]
{:pulse_id pulse-id
:card_id card-id
:dashboard_card_id dashcard-id
:position position})]
(t2/with-transaction [_conn]
(binding [pulse/*allow-moving-dashboard-subscriptions* true]
(t2/update! Pulse {:dashboard_id dashboard-id}
{:name (:name dashboard)
:collection_id (:collection_id dashboard)})
(pulse-card/bulk-create! new-pulse-cards))))))) |
(t2/define-after-update :model/Dashboard [dashboard] (update-dashboard-subscription-pulses! dashboard)) | |
(defn- migrate-parameter [p]
(cond-> p
;; It was previously possible for parameters to have empty strings for :name and
;; :slug, but these are now required to be non-blank strings. (metabase#24500)
(or (= (:name p) )
(= (:slug p) ))
(assoc :name "unnamed" :slug "unnamed")
(or
;; we don't support linked filters for parameters with :values_source_type of anything except nil,
;; but it was previously possible to set :values_source_type to "static-list" or "card" and still
;; have linked filters. (metabase#33892)
(some? (:values_source_type p))
(= (:values_query_type p) "none"))
;; linked filters don't do anything when parameters have values_query_type="none" (aka "Input box"),
;; but it was previously possible to set :values_query_type to "none" and still have linked filters.
;; (metabase#34657)
(dissoc :filteringParameters))) | |
Update the | (defn- migrate-parameters-list [dashboard] (m/update-existing dashboard :parameters #(map migrate-parameter %))) |
(t2/define-after-select :model/Dashboard
[dashboard]
(-> dashboard
migrate-parameters-list
public-settings/remove-public-uuid-if-public-sharing-is-disabled)) | |
(defmethod serdes/hash-fields :model/Dashboard [_dashboard] [:name (serdes/hydrated-hash :collection) :created_at]) | |
--------------------------------------------------- Hydration ---------------------------------------------------- | |
(mi/define-simple-hydration-method tabs
:tabs
"Return the ordered DashboardTabs associated with `dashboard-or-id`, sorted by tab position."
[dashboard-or-id]
(t2/select :model/DashboardTab :dashboard_id (u/the-id dashboard-or-id) {:order-by [[:position :asc]]})) | |
(mi/define-simple-hydration-method dashcards
:dashcards
"Return the DashboardCards associated with `dashboard`, in the order they were created."
[dashboard-or-id]
(t2/select DashboardCard
{:select [:dashcard.* [:collection.authority_level :collection_authority_level]]
:from [[:report_dashboardcard :dashcard]]
:left-join [[:report_card :card] [:= :dashcard.card_id :card.id]
[:collection :collection] [:= :collection.id :card.collection_id]]
:where [:and
[:= :dashcard.dashboard_id (u/the-id dashboard-or-id)]
[:or
[:= :card.archived false]
[:= :card.archived nil]]] ; e.g. DashCards with no corresponding Card, e.g. text Cards
:order-by [[:dashcard.created_at :asc]]})) | |
(mi/define-batched-hydration-method collections-authority-level
:collection_authority_level
"Efficiently hydrate the `:collection_authority_level` of a sequence of dashboards."
[dashboards]
(when (seq dashboards)
(let [coll-id->level (into {}
(map (juxt :id :authority_level))
(mdb.query/query {:select [:dashboard.id :collection.authority_level]
:from [[:report_dashboard :dashboard]]
:left-join [[:collection :collection] [:= :collection.id :dashboard.collection_id]]
:where [:in :dashboard.id (into #{} (map u/the-id) dashboards)]}))]
(for [dashboard dashboards]
(assoc dashboard :collection_authority_level (get coll-id->level (u/the-id dashboard))))))) | |
(comment moderation/keep-me) | |
--------------------------------------------------- Revisions ---------------------------------------------------- | |
(def ^:private excluded-columns-for-dashboard-revision [:id :created_at :updated_at :creator_id :points_of_interest :caveats :show_in_getting_started :entity_id ;; not sure what position is for, from the column remark: ;; > The position this Dashboard should appear in the Dashboards list, ;; lower-numbered positions appearing before higher numbered ones. ;; TODO: querying on stats we don't have any dashboard that has a position, maybe we could just drop it? :public_uuid :made_public_by_id :position]) | |
(def ^:private excluded-columns-for-dashcard-revision [:entity_id :created_at :updated_at :collection_authority_level]) | |
(def ^:private excluded-columns-for-dashboard-tab-revision [:created_at :updated_at :entity_id]) | |
(defmethod revision/serialize-instance :model/Dashboard
[_model _id dashboard]
(let [dashcards (or (:dashcards dashboard)
(dashcards dashboard))
dashcards (when (seq dashcards)
(if (contains? (first dashcards) :series)
dashcards
(t2/hydrate dashcards :series)))
tabs (or (:tabs dashboard)
(tabs dashboard))]
(-> (apply dissoc dashboard excluded-columns-for-dashboard-revision)
(assoc :cards (vec (for [dashboard-card dashcards]
(-> (apply dissoc dashboard-card excluded-columns-for-dashcard-revision)
(assoc :series (mapv :id (:series dashboard-card)))))))
(assoc :tabs (map #(apply dissoc % excluded-columns-for-dashboard-tab-revision) tabs))))) | |
(defn- revert-dashcards
[dashboard-id serialized-cards]
(let [current-cards (t2/select-fn-vec #(apply dissoc (t2.realize/realize %) excluded-columns-for-dashcard-revision)
:model/DashboardCard
:dashboard_id dashboard-id)
id->current-card (zipmap (map :id current-cards) current-cards)
{:keys [to-create to-update to-delete]} (u/classify-changes current-cards serialized-cards)]
(when (seq to-delete)
(dashboard-card/delete-dashboard-cards! (map :id to-delete)))
(when (seq to-create)
(dashboard-card/create-dashboard-cards! (map #(assoc % :dashboard_id dashboard-id) to-create)))
(when (seq to-update)
(doseq [update-card to-update]
(dashboard-card/update-dashboard-card! update-card (id->current-card (:id update-card))))))) | |
Given a list of dashcards, remove any dashcard that references cards that are either archived or not exist. | (defn- remove-invalid-dashcards
[dashcards]
(let [card-ids (set (keep :card_id dashcards))
active-card-ids (when-let [card-ids (seq card-ids)]
(t2/select-pks-set :model/Card :id [:in card-ids] :archived false))
inactive-card-ids (set/difference card-ids active-card-ids)]
(remove #(contains? inactive-card-ids (:card_id %)) dashcards))) |
(defmethod revision/revert-to-revision! :model/Dashboard
[_model dashboard-id _user-id serialized-dashboard]
;; Update the dashboard description / name / permissions
(t2/update! :model/Dashboard dashboard-id (dissoc serialized-dashboard :cards :tabs))
;; Now update the tabs and cards as needed
(let [serialized-dashcards (:cards serialized-dashboard)
current-tabs (t2/select-fn-vec #(dissoc (t2.realize/realize %) :created_at :updated_at :entity_id :dashboard_id)
:model/DashboardTab :dashboard_id dashboard-id)
{:keys [old->new-tab-id]} (dashboard-tab/do-update-tabs! dashboard-id current-tabs (:tabs serialized-dashboard))
serialized-dashcards (cond->> serialized-dashcards
true
remove-invalid-dashcards
;; in case reverting result in new tabs being created,
;; we need to remap the tab-id
(seq old->new-tab-id)
(map (fn [card]
(if-let [new-tab-id (get old->new-tab-id (:dashboard_tab_id card))]
(assoc card :dashboard_tab_id new-tab-id)
card))))]
(revert-dashcards dashboard-id serialized-dashcards))
serialized-dashboard) | |
(defmethod revision/diff-strings :model/Dashboard
[_model prev-dashboard dashboard]
(let [[removals changes] (diff prev-dashboard dashboard)
check-series-change (fn [idx card-changes]
(when (and (:series card-changes)
(get-in prev-dashboard [:cards idx :card_id]))
(let [num-series₁ (count (get-in prev-dashboard [:cards idx :series]))
num-series₂ (count (get-in dashboard [:cards idx :series]))]
(cond
(< num-series₁ num-series₂)
(deferred-tru "added some series to card {0}" (get-in prev-dashboard [:cards idx :card_id]))
(> num-series₁ num-series₂)
(deferred-tru "removed some series from card {0}" (get-in prev-dashboard [:cards idx :card_id]))
:else
(deferred-tru "modified the series on card {0}" (get-in prev-dashboard [:cards idx :card_id]))))))]
(-> [(when-let [default-description (u/build-sentence ((get-method revision/diff-strings :default) Dashboard prev-dashboard dashboard))]
(cond-> default-description
(str/ends-with? default-description ".") (subs 0 (dec (count default-description)))))
(when (:cache_ttl changes)
(cond
(nil? (:cache_ttl prev-dashboard)) (deferred-tru "added a cache ttl")
(nil? (:cache_ttl dashboard)) (deferred-tru "removed the cache ttl")
:else (deferred-tru "changed the cache ttl from \"{0}\" to \"{1}\""
(:cache_ttl prev-dashboard) (:cache_ttl dashboard))))
(when (or (:cards changes) (:cards removals))
(let [prev-card-ids (set (map :id (:cards prev-dashboard)))
num-prev-cards (count prev-card-ids)
new-card-ids (set (map :id (:cards dashboard)))
num-new-cards (count new-card-ids)
num-cards-diff (abs (- num-prev-cards num-new-cards))
keys-changes (set (flatten (concat (map keys (:cards changes))
(map keys (:cards removals)))))]
(cond
(and
(set/subset? prev-card-ids new-card-ids)
(< num-prev-cards num-new-cards)) (deferred-trun "added a card" "added {0} cards" num-cards-diff)
(and
(set/subset? new-card-ids prev-card-ids)
(> num-prev-cards num-new-cards)) (deferred-trun "removed a card" "removed {0} cards" num-cards-diff)
(set/subset? keys-changes #{:row :col :size_x :size_y}) (deferred-tru "rearranged the cards")
:else (deferred-tru "modified the cards"))))
(when (or (:tabs changes) (:tabs removals))
(let [prev-tabs (:tabs prev-dashboard)
new-tabs (:tabs dashboard)
prev-tab-ids (set (map :id prev-tabs))
num-prev-tabs (count prev-tab-ids)
new-tab-ids (set (map :id new-tabs))
num-new-tabs (count new-tab-ids)
num-tabs-diff (abs (- num-prev-tabs num-new-tabs))]
(cond
(and
(set/subset? prev-tab-ids new-tab-ids)
(< num-prev-tabs num-new-tabs)) (deferred-trun "added a tab" "added {0} tabs" num-tabs-diff)
(and
(set/subset? new-tab-ids prev-tab-ids)
(> num-prev-tabs num-new-tabs)) (deferred-trun "removed a tab" "removed {0} tabs" num-tabs-diff)
(= (set (map #(dissoc % :position) prev-tabs))
(set (map #(dissoc % :position) new-tabs))) (deferred-tru "rearranged the tabs")
:else (deferred-tru "modified the tabs"))))
(let [f (comp boolean :auto_apply_filters)]
(when (not= (f prev-dashboard) (f dashboard))
(deferred-tru "set auto apply filters to {0}" (str (f dashboard)))))]
(concat (map-indexed check-series-change (:cards changes)))
(->> (filter identity))))) | |
Check if a dashboard has tabs. | (defn has-tabs? [dashboard-or-id] (t2/exists? :model/DashboardTab :dashboard_id (u/the-id dashboard-or-id))) |
+----------------------------------------------------------------------------------------------------------------+ | OTHER CRUD FNS | +----------------------------------------------------------------------------------------------------------------+ | |
Get the set of Field IDs referenced by the parameters in this Dashboard. | (defn- dashboard-id->param-field-ids
[dashboard-or-id]
(let [dash (-> (t2/select-one Dashboard :id (u/the-id dashboard-or-id))
(t2/hydrate [:dashcards :card]))]
(params/dashcards->param-field-ids (:dashcards dash)))) |
If the parameters have changed since last time this Dashboard was saved, we need to update the FieldValues for any Fields that belong to an 'On-Demand' synced DB. | (defn- update-field-values-for-on-demand-dbs!
[old-param-field-ids new-param-field-ids]
(when (and (seq new-param-field-ids)
(not= old-param-field-ids new-param-field-ids))
(let [newly-added-param-field-ids (set/difference new-param-field-ids old-param-field-ids)]
(log/info "Referenced Fields in Dashboard params have changed: Was:" old-param-field-ids
"Is Now:" new-param-field-ids
"Newly Added:" newly-added-param-field-ids)
(field-values/update-field-values-for-on-demand-dbs! newly-added-param-field-ids)))) |
Add Cards to a Dashboard. This function is provided for convenience and also makes sure various cleanup steps are performed when finished, for example updating FieldValues for On-Demand DBs. Returns newly created DashboardCards. | (defn add-dashcards!
{:style/indent 2}
[dashboard-or-id dashcards]
(let [old-param-field-ids (dashboard-id->param-field-ids dashboard-or-id)
dashboard-cards (map (fn [dashcard]
(-> (assoc dashcard :dashboard_id (u/the-id dashboard-or-id))
(update :series #(filter identity (map u/the-id %))))) dashcards)]
(u/prog1 (dashboard-card/create-dashboard-cards! dashboard-cards)
(let [new-param-field-ids (dashboard-id->param-field-ids dashboard-or-id)]
(update-field-values-for-on-demand-dbs! old-param-field-ids new-param-field-ids))))) |
(def ^:private DashboardWithSeriesAndCard
[:map
[:id ms/PositiveInt]
[:dashcards [:sequential [:map
[:card_id {:optional true} [:maybe ms/PositiveInt]]
[:card {:optional true} [:maybe [:map
[:id ms/PositiveInt]]]]]]]]) | |
Update the | (mu/defn update-dashcards!
{:style/indent 1}
[dashboard :- DashboardWithSeriesAndCard
new-dashcards :- [:sequential ms/Map]]
(let [old-dashcards (:dashcards dashboard)
id->old-dashcard (m/index-by :id old-dashcards)
old-dashcard-ids (set (keys id->old-dashcard))
new-dashcard-ids (set (map :id new-dashcards))
only-new (set/difference new-dashcard-ids old-dashcard-ids)]
;; ensure the dashcards we are updating are part of the given dashboard
(when (seq only-new)
(throw (ex-info (tru "Dashboard {0} does not have a DashboardCard with ID {1}"
(u/the-id dashboard) (first only-new))
{:status-code 404})))
(doseq [dashcard new-dashcards]
(let [;; update-dashboard-card! requires series to be a sequence of card IDs
old-dashcard (-> (get id->old-dashcard (:id dashcard))
(update :series #(map :id %)))
dashboard-card (update dashcard :series #(map :id %))]
(dashboard-card/update-dashboard-card! dashboard-card old-dashcard)))
(let [new-param-field-ids (params/dashcards->param-field-ids (t2/hydrate new-dashcards :card))]
(update-field-values-for-on-demand-dbs! (params/dashcards->param-field-ids old-dashcards) new-param-field-ids)))) |
Fetch the results metadata for a TODO - we need to actually make this async, but then we'd need to make | (defn- result-metadata-for-query [query] (a/<!! (qp.async/result-metadata-for-query-async query))) |
(defn- save-card!
[card]
(cond
;; If this is a pre-existing card, just return it
(and (integer? (:id card)) (t2/select-one Card :id (:id card)))
card
;; Don't save text cards
(-> card :dataset_query not-empty)
(let [card (first (t2/insert-returning-instances!
Card
(-> card
(update :result_metadata #(or % (-> card
:dataset_query
result-metadata-for-query)))
(dissoc :id))))]
(events/publish-event! :event/card-create {:object card :user-id (:creator_id card)})
(t2/hydrate card :creator :dashboard_count :can_write :collection)))) | |
(defn- ensure-unique-collection-name
[collection-name parent-collection-id]
(let [c (t2/count Collection
:name [:like (format "%s%%" collection-name)]
:location (collection/children-location (t2/select-one [Collection :location :id]
:id parent-collection-id)))]
(if (zero? c)
collection-name
(format "%s %s" collection-name (inc c))))) | |
Save a denormalized description of | (defn save-transient-dashboard!
[dashboard parent-collection-id]
(let [{dashcards :dashcards
tabs :tabs
dashboard-name :name
:keys [description] :as dashboard} (i18n/localized-strings->strings dashboard)
collection (populate/create-collection!
(ensure-unique-collection-name dashboard-name parent-collection-id)
"Automatically generated cards."
parent-collection-id)
dashboard (first (t2/insert-returning-instances!
:model/Dashboard
(-> dashboard
(dissoc :dashcards :tabs :rule :related
:transient_name :transient_filters :param_fields :more)
(assoc :description description
:collection_id (:id collection)
:collection_position 1))))
{:keys [old->new-tab-id]} (dashboard-tab/do-update-tabs! (:id dashboard) nil tabs)]
(add-dashcards! dashboard
(for [dashcard dashcards]
(let [card (some-> dashcard :card (assoc :collection_id (:id collection)) save-card!)
series (some->> dashcard :series (map (fn [card]
(-> card
(assoc :collection_id (:id collection))
save-card!))))
dashcard (-> dashcard
(dissoc :card :id :creator_id)
(update :parameter_mappings
(partial map #(assoc % :card_id (:id card))))
(assoc :series series)
(update :dashboard_tab_id (or old->new-tab-id {}))
(assoc :card_id (:id card)))]
dashcard)))
dashboard)) |
(def ^:private ParamWithMapping [:map [:id ms/NonBlankString] [:name ms/NonBlankString] [:mappings [:maybe [:set dashboard-card/ParamMapping]]]]) | |
(mu/defn ^:private dashboard->resolved-params* :- [:map-of ms/NonBlankString ParamWithMapping]
[dashboard :- [:map [:parameters [:maybe [:sequential :map]]]]]
(let [dashboard (t2/hydrate dashboard [:dashcards :card])
param-key->mappings (apply
merge-with set/union
(for [dashcard (:dashcards dashboard)
param (:parameter_mappings dashcard)]
{(:parameter_id param) #{(assoc param :dashcard dashcard)}}))]
(into {} (for [{param-key :id, :as param} (:parameters dashboard)]
[(u/qualified-name param-key) (assoc param :mappings (get param-key->mappings param-key))])))) | |
(mi/define-simple-hydration-method dashboard->resolved-params
:resolved-params
"Return map of Dashboard parameter key -> param with resolved `:mappings`.
(dashboard->resolved-params (t2/select-one Dashboard :id 62))
;; ->
{\"ee876336\" {:name \"Category Name\"
:slug \"category_name\"
:id \"ee876336\"
:type \"category\"
:mappings #{{:parameter_id \"ee876336\"
:card_id 66
:dashcard ...
:target [:dimension [:fk-> [:field-id 263] [:field-id 276]]]}}},
\"6f10a41f\" {:name \"Price\"
:slug \"price\"
:id \"6f10a41f\"
:type \"category\"
:mappings #{{:parameter_id \"6f10a41f\"
:card_id 66
:dashcard ...
:target [:dimension [:field-id 264]]}}}}"
[dashboard]
(dashboard->resolved-params* dashboard)) | |
+----------------------------------------------------------------------------------------------------------------+ | SERIALIZATION | +----------------------------------------------------------------------------------------------------------------+ | (defmethod serdes/extract-query "Dashboard" [_ opts]
(eduction (map #(t2/hydrate % [:dashcards :series]))
(serdes/extract-query-collections Dashboard opts))) |
Given the hydrated | (defn export-dashboard-card-series
[cards]
(mapv (fn [card]
{:card_id (serdes/*export-fk* (:id card) :model/Card)})
cards)) |
(defn- extract-dashcard
[dashcard]
(-> (into (sorted-map) dashcard)
(dissoc :id :collection_authority_level :dashboard_id :updated_at)
(update :card_id serdes/*export-fk* 'Card)
(update :action_id serdes/*export-fk* 'Action)
(update :dashboard_tab_id serdes/*export-fk* :model/DashboardTab)
(update :series export-dashboard-card-series)
(update :parameter_mappings serdes/export-parameter-mappings)
(update :visualization_settings serdes/export-visualization-settings))) | |
(defn- extract-dashtab [dashtab] (dissoc dashtab :id :dashboard_id :updated_at)) | |
(defmethod serdes/extract-one "Dashboard"
[_model-name _opts dash]
(let [dash (cond-> dash
(nil? (:dashcards dash))
(t2/hydrate [:dashcards :series])
(nil? (:tabs dash))
(t2/hydrate :tabs))]
(-> (serdes/extract-one-basics "Dashboard" dash)
(update :dashcards #(mapv extract-dashcard %))
(update :tabs #(mapv extract-dashtab %))
(update :parameters serdes/export-parameters)
(update :collection_id serdes/*export-fk* Collection)
(update :creator_id serdes/*export-user*)
(update :made_public_by_id serdes/*export-user*)))) | |
(defmethod serdes/load-xform "Dashboard"
[dash]
(-> dash
serdes/load-xform-basics
;; Deliberately not doing anything to :dashcards - they get handled by load-one! below.
(update :collection_id serdes/*import-fk* Collection)
(update :parameters serdes/import-parameters)
(update :creator_id serdes/*import-user*)
(update :made_public_by_id serdes/*import-user*))) | |
(defn- dashcard-for [dashcard dashboard]
(assoc dashcard
:dashboard_id (:entity_id dashboard)
:serdes/meta (remove nil?
[{:model "Dashboard" :id (:entity_id dashboard)}
(when-let [dashtab-eeid (last (:dashboard_tab_id dashcard))]
{:model "DashboardTab" :id dashtab-eeid})
{:model "DashboardCard" :id (:entity_id dashcard)}]))) | |
(defn- dashtab-for [tab dashboard]
(assoc tab
:dashboard_id (:entity_id dashboard)
:serdes/meta [{:model "Dashboard" :id (:entity_id dashboard)}
{:model "DashboardTab" :id (:entity_id tab)}])) | |
Remove nested entities which are not present in incoming serialization load | (defn- drop-excessive-nested!
[hydration-key ingested local]
(let [local-nested (get (t2/hydrate local hydration-key) hydration-key)
ingested-nested (get ingested hydration-key)
to-remove (set/difference (set (map :entity_id local-nested))
(set (map :entity_id ingested-nested)))
model (t2/model (first local-nested))]
(when (seq to-remove)
(t2/delete! model :entity_id [:in to-remove])))) |
Call the default load-one! for the Dashboard, then for each DashboardCard. | (defmethod serdes/load-one! "Dashboard" [ingested maybe-local]
(let [dashboard ((get-method serdes/load-one! :default) (dissoc ingested :dashcards :tabs) maybe-local)]
(drop-excessive-nested! :tabs ingested dashboard)
(doseq [tab (:tabs ingested)]
(serdes/load-one! (dashtab-for tab dashboard)
(t2/select-one :model/DashboardTab :entity_id (:entity_id tab))))
(drop-excessive-nested! :dashcards ingested dashboard)
(doseq [dashcard (:dashcards ingested)]
(serdes/load-one! (dashcard-for dashcard dashboard)
(t2/select-one :model/DashboardCard :entity_id (:entity_id dashcard)))))) |
(defn- serdes-deps-dashcard
[{:keys [action_id card_id parameter_mappings visualization_settings series]}]
(->> (mapcat serdes/mbql-deps parameter_mappings)
(concat (serdes/visualization-settings-deps visualization_settings))
(concat (when card_id #{[{:model "Card" :id card_id}]}))
(concat (when action_id #{[{:model "Action" :id action_id}]}))
(concat (for [s series] [{:model "Card" :id (:card_id s)}]))
set)) | |
(defmethod serdes/dependencies "Dashboard"
[{:keys [collection_id dashcards parameters]}]
(->> (map serdes-deps-dashcard dashcards)
(reduce set/union #{})
(set/union (when collection_id #{[{:model "Collection" :id collection_id}]}))
(set/union (serdes/parameters-deps parameters)))) | |
(defmethod serdes/descendants "Dashboard" [_model-name id]
(let [dashcards (t2/select ['DashboardCard :id :card_id :action_id :parameter_mappings :visualization_settings]
:dashboard_id id)
dashboard (t2/select-one Dashboard :id id)]
(set/union
;; DashboardCards are inlined into Dashboards, but we need to capture what those those DashboardCards rely on
;; here. So their actions, and their cards both direct, mentioned in their parameters viz settings, and related
;; via dashboard card series.
(set (for [{:keys [card_id parameter_mappings]} dashcards
;; Capture all card_ids in the parameters, plus this dashcard's card_id if non-nil.
card-id (cond-> (set (keep :card_id parameter_mappings))
card_id (conj card_id))]
["Card" card-id]))
(when (not-empty dashcards)
(set (for [card-id (t2/select-fn-set :card_id :model/DashboardCardSeries :dashboardcard_id [:in (map :id dashcards)])]
["Card" card-id])))
(set (for [{:keys [action_id]} dashcards
:when action_id]
["Action" action_id]))
(reduce set/union #{}
(for [dc dashcards]
(serdes/visualization-settings-descendants (:visualization_settings dc))))
;; parameter with values_source_type = "card" will depend on a card
(set (for [card-id (some->> dashboard :parameters (keep (comp :card_id :values_source_config)))]
["Card" card-id]))))) | |
------------------------------------------------ Audit Log -------------------------------------------------------- | |
(defmethod audit-log/model-details Dashboard
[dashboard event-type]
(case event-type
(:dashboard-create :dashboard-delete :dashboard-read)
(select-keys dashboard [:description :name])
(:dashboard-add-cards :dashboard-remove-cards)
(-> (select-keys dashboard [:description :name :parameters :dashcards])
(update :dashcards (fn [dashcards]
(for [{:keys [id card_id]} dashcards]
(-> (t2/select-one [Card :name :description], :id card_id)
(assoc :id id)
(assoc :card_id card_id))))))
{})) | |
(ns metabase.models.dashboard-card (:require [clojure.set :as set] [medley.core :as m] [metabase.db :as mdb] [metabase.db.query :as mdb.query] [metabase.models.dashboard-card-series :refer [DashboardCardSeries]] [metabase.models.interface :as mi] [metabase.models.pulse-card :refer [PulseCard]] [metabase.models.serialization :as serdes] [metabase.util :as u] [metabase.util.date-2 :as u.date] [metabase.util.honey-sql-2 :as h2x] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [methodical.core :as methodical] [toucan2.core :as t2])) | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all the DashboardCard symbol in our codebase. | (def DashboardCard :model/DashboardCard) |
(methodical/defmethod t2/table-name :model/DashboardCard [_model] :report_dashboardcard) | |
(doto :model/DashboardCard (derive :metabase/model) (derive ::mi/read-policy.full-perms-for-perms-set) (derive ::mi/write-policy.full-perms-for-perms-set) (derive :hook/timestamped?) (derive :hook/entity-id)) | |
(t2/deftransforms :model/DashboardCard
{:parameter_mappings mi/transform-parameters-list
:visualization_settings mi/transform-visualization-settings}) | |
(t2/define-before-insert :model/DashboardCard
[dashcard]
(merge {:parameter_mappings []
:visualization_settings {}} dashcard)) | |
(declare series) | |
Return the set of permissions required to | (defmethod mi/perms-objects-set :model/DashboardCard
[dashcard read-or-write]
(let [card (or (:card dashcard)
(t2/select-one [:model/Card :dataset_query] :id (u/the-id (:card_id dashcard))))
series (or (:series dashcard)
(series dashcard))]
(apply set/union (mi/perms-objects-set card read-or-write) (for [series-card series]
(mi/perms-objects-set series-card read-or-write))))) |
Convert a map with dashboard-card into a Toucan instance assuming it came from parsed JSON and the map keys have
been keywordized. This is useful if the data from a request body inside a For example: ``` (= dashcard ;; from toucan select, excluding :createdat and :updatedat (-> (json/generate-string dashcard) (json/parse-string true) from-parsed-json)) => true ``` | (defn from-parsed-json
[dashboard-card]
(t2/instance :model/DashboardCard
(-> dashboard-card
(m/update-existing :parameter_mappings mi/normalize-parameters-list)
(m/update-existing :visualization_settings mi/normalize-visualization-settings)))) |
(defmethod serdes/hash-fields :model/DashboardCard
[_dashboard-card]
[(serdes/hydrated-hash :card) ; :card is optional, eg. text cards
(comp serdes/identity-hash
#(t2/select-one 'Dashboard :id %)
:dashboard_id)
:visualization_settings
:row :col
:created_at]) | |
--------------------------------------------------- HYDRATION ---------------------------------------------------- | |
(mi/define-batched-hydration-method series
:series
"Return the `Cards` associated as additional series on this DashboardCard."
[dashcards]
(let [dashcard-ids (map :id dashcards)
dashcard-id->series (when (seq dashcard-ids)
(as-> (t2/select
[:model/Card :id :name :description :display :dataset_query
:visualization_settings :collection_id :series.dashboardcard_id]
{:left-join [[:dashboardcard_series :series] [:= :report_card.id :series.card_id]]
:where [:in :series.dashboardcard_id dashcard-ids]
:order-by [[:series.position :asc]]}) series
(group-by :dashboardcard_id series)
(update-vals series #(map (fn [card] (dissoc card :dashboardcard_id)) %))))]
(map (fn [dashcard]
(assoc dashcard :series (get dashcard-id->series (:id dashcard) [])))
dashcards))) | |
---------------------------------------------------- CRUD FNS ---------------------------------------------------- | |
Fetch a single DashboardCard by its ID value. | (mu/defn retrieve-dashboard-card
[id :- ms/PositiveInt]
(-> (t2/select-one :model/DashboardCard :id id)
(t2/hydrate :series))) |
Return the cards which are other cards with respect to this dashboard card in multiple series display for dashboard Dashboard (and dashboard only) has this thing where you're displaying multiple cards entirely. This is actually completely different from the combo display, which is a visualization type in visualization option. This is also actually completely different from having multiple series display from the visualization with same type (line bar or whatever), which is a separate option in line area or bar visualization | (defn dashcard->multi-cards
[dashcard]
(mdb.query/query {:select [:newcard.*]
:from [[:report_dashboardcard :dashcard]]
:left-join [[:dashboardcard_series :dashcardseries]
[:= :dashcard.id :dashcardseries.dashboardcard_id]
[:report_card :newcard]
[:= :dashcardseries.card_id :newcard.id]]
:where [:and
[:= :newcard.archived false]
[:= :dashcard.id (:id dashcard)]]})) |
Batch update the DashboardCardSeries for multiple DashboardCards.
Each
| (defn update-dashboard-cards-series!
{:arglists '([dashcard-id->card-ids])}
[dashcard-id->card-ids]
(when (seq dashcard-id->card-ids)
;; first off, just delete all series on the dashboard card (we add them again below)
(t2/delete! DashboardCardSeries :dashboardcard_id [:in (keys dashcard-id->card-ids)])
;; now just insert all of the series that were given to us
(when-let [card-series (seq (for [[dashcard-id card-ids] dashcard-id->card-ids
[i card-id] (map-indexed vector card-ids)]
{:dashboardcard_id dashcard-id, :card_id card-id, :position i}))]
(t2/insert! DashboardCardSeries card-series)))) |
(def ^:private DashboardCardUpdates
[:map
[:id ms/PositiveInt]
[:action_id {:optional true} [:maybe ms/PositiveInt]]
[:parameter_mappings {:optional true} [:maybe [:sequential :map]]]
[:visualization_settings {:optional true} [:maybe :map]]
;; series is a sequence of IDs of additional cards after the first to include as "additional serieses"
[:series {:optional true} [:maybe [:sequential ms/PositiveInt]]]]) | |
Returns the keys in | (defn- shallow-updates
[new old]
(into {}
(filter (fn [[k v]]
(not= v (get old k)))
new))) |
Updates an existing DashboardCard including all DashboardCardSeries.
| (mu/defn update-dashboard-card!
[{dashcard-id :id :keys [series] :as dashboard-card} :- DashboardCardUpdates
old-dashboard-card :- DashboardCardUpdates]
(t2/with-transaction [_conn]
(let [update-ks [:action_id :card_id :row :col :size_x :size_y
:parameter_mappings :visualization_settings :dashboard_tab_id]
updates (shallow-updates (select-keys dashboard-card update-ks)
(select-keys old-dashboard-card update-ks))]
(when (seq updates)
(t2/update! :model/DashboardCard dashcard-id updates))
(when (not= (:series dashboard-card [])
(:series old-dashboard-card []))
(update-dashboard-cards-series! {dashcard-id series}))
nil))) |
Schema for a parameter mapping as it would appear in the DashboardCard | (def ParamMapping
[:and
[:map-of :keyword :any]
[:map
;; TODO -- validate `:target` as well... breaks a few tests tho so those will have to be fixed
[:parameter_id ms/NonBlankString]
#_[:target :any]]]) |
(def ^:private NewDashboardCard
;; TODO - make the rest of the options explicit instead of just allowing whatever for other keys
[:map
[:dashboard_id ms/PositiveInt]
[:action_id {:optional true} [:maybe ms/PositiveInt]]
;; TODO - use ParamMapping. Breaks too many tests right now tho
[:parameter_mappings {:optional true} [:maybe [:sequential map?]]]
[:visualization_settings {:optional true} [:maybe map?]]
[:series {:optional true} [:maybe [:sequential ms/PositiveInt]]]]) | |
Create a new DashboardCard by inserting it into the database along with all associated pieces of data such as DashboardCardSeries. Returns the newly created DashboardCard or throws an Exception. | (mu/defn create-dashboard-cards!
[dashboard-cards :- [:sequential NewDashboardCard]]
(when (seq dashboard-cards)
(t2/with-transaction [_conn]
(let [dashboard-card-ids (t2/insert-returning-pks!
DashboardCard
(for [dashcard dashboard-cards]
(merge {:parameter_mappings []
:visualization_settings {}}
(dissoc dashcard :id :created_at :updated_at :entity_id :series :card :collection_authority_level))))]
;; add series to the DashboardCard
(update-dashboard-cards-series! (zipmap dashboard-card-ids (map #(get % :series []) dashboard-cards)))
;; return the full DashboardCard
(-> (t2/select DashboardCard :id [:in dashboard-card-ids])
(t2/hydrate :series)))))) |
Delete DashboardCards of a Dasbhoard. | (defn delete-dashboard-cards!
[dashboard-card-ids]
{:pre [(coll? dashboard-card-ids)]}
(t2/with-transaction [_conn]
(t2/delete! PulseCard :dashboard_card_id [:in dashboard-card-ids])
(t2/delete! DashboardCard :id [:in dashboard-card-ids]))) |
----------------------------------------------- Link cards ---------------------------------------------------- | |
(def ^:private all-card-info-columns
{:model :text
:id :integer
:name :text
:description :text
;; for cards and datasets
:collection_id :integer
:display :text
;; for tables
:db_id :integer}) | |
(def ^:private link-card-columns-for-model
{"database" [:id :name :description]
"table" [:id [:display_name :name] :description :db_id]
"dashboard" [:id :name :description :collection_id]
"card" [:id :name :description :collection_id :display]
"dataset" [:id :name :description :collection_id :display]
"collection" [:id :name :description]}) | |
Returns the column name. If the column is aliased, i.e. [ | (defn- ->column-alias
[column-or-aliased]
(if (sequential? column-or-aliased)
(second column-or-aliased)
column-or-aliased)) |
The search query uses a | (defn- select-clause-for-link-card-model
[model]
(let [model-cols (link-card-columns-for-model model)
model-col-alias->honeysql-clause (m/index-by ->column-alias model-cols)]
(for [[col col-type] all-card-info-columns
:let [maybe-aliased-col (get model-col-alias->honeysql-clause col)]]
(cond
(= col :model)
[(h2x/literal model) :model]
maybe-aliased-col
maybe-aliased-col
;; This entity is missing the column, project a null for that column value. For Postgres and H2, cast it to the
;; correct type, e.g.
;;
;; SELECT cast(NULL AS integer)
;;
;; For MySQL, this is not needed.
:else
[(when-not (= (mdb/db-type) :mysql)
[:cast nil col-type])
col])))) |
(def ^:private link-card-models (set (keys serdes/link-card-model->toucan-model))) | |
Return a honeysql query that is used to fetch info for a linkcard. | (defn link-card-info-query-for-model
[model id-or-ids]
{:select (select-clause-for-link-card-model model)
:from (t2/table-name (serdes/link-card-model->toucan-model model))
:where (if (coll? id-or-ids)
[:in :id id-or-ids]
[:= :id id-or-ids])}) |
(defn- link-card-info-query
[link-card-model->ids]
(if (= 1 (count link-card-model->ids))
(apply link-card-info-query-for-model (first link-card-model->ids))
{:select [:*]
:from [[{:union-all (map #(apply link-card-info-query-for-model %) link-card-model->ids)}
:alias_is_required_by_sql_but_not_needed_here]]})) | |
(mi/define-batched-hydration-method dashcard-linkcard-info
:dashcard/linkcard-info
"Update entity info for link cards.
Link cards are dashcards that link to internal entities like Database/Dashboard/... or an url.
The viz-settings only store the model name and id, info like name, description will need to be
hydrated on fetch to make sure those info are up-to-date."
[dashcards]
(let [entity-path [:visualization_settings :link :entity]
;; find all dashcards that are link-cards and get its model, id
;; [[:table #{1 2}] [:database #{3 4}]]
model-and-ids (->> dashcards
(map #(get-in % entity-path))
(filter #(link-card-models (:model %)))
(group-by :model)
(map (fn [[k v]] [k (set (map :id v))])))]
(if (seq model-and-ids)
(let [;; query all entities in 1 db call
;; {[:table 3] {:name ...}}
model-and-id->info
(-> (m/index-by (juxt :model :id) (t2/query (link-card-info-query model-and-ids)))
(update-vals (fn [{model :model :as instance}]
(if (mi/can-read? (t2/instance (serdes/link-card-model->toucan-model model) instance))
instance
{:restricted true}))))]
(map (fn [card]
(if-let [model-info (->> (get-in card entity-path)
((juxt :model :id))
(get model-and-id->info))]
(assoc-in card entity-path model-info)
card))
dashcards))
dashcards))) | |
Comparator that determines which of two dashcards comes first in the layout order used for pulses. This is the same order used on the frontend for the mobile layout. Orders cards left-to-right, then top-to-bottom | (defn dashcard-comparator
[{row-1 :row col-1 :col} {row-2 :row col-2 :col}]
(if (= row-1 row-2)
(compare col-1 col-2)
(compare row-1 row-2))) |
----------------------------------------------- SERIALIZATION ---------------------------------------------------- DashboardCards are not serialized as their own, separate entities. They are inlined onto their parent Dashboards. If the parent dashboard has tabs, the dashcards are inlined under each DashboardTab, which are inlined on the Dashboard. However, we can reuse some of the serdes machinery (especially load-one!) by implementing a few serdes methods. | (defmethod serdes/generate-path "DashboardCard" [_ dashcard]
(remove nil?
[(serdes/infer-self-path "Dashboard" (t2/select-one 'Dashboard :id (:dashboard_id dashcard)))
(when (:dashboard_tab_id dashcard)
(serdes/infer-self-path "DashboardTab" (t2/select-one :model/DashboardTab :id (:dashboard_tab_id dashcard))))
(serdes/infer-self-path "DashboardCard" dashcard)])) |
(defmethod serdes/load-xform "DashboardCard"
[dashcard]
(-> dashcard
;; Deliberately not doing anything to :series, they get handled by load-one! below
(dissoc :serdes/meta)
(update :card_id serdes/*import-fk* :model/Card)
(update :action_id serdes/*import-fk* :model/Action)
(update :dashboard_id serdes/*import-fk* :model/Dashboard)
(update :dashboard_tab_id serdes/*import-fk* :model/DashboardTab)
(update :created_at #(if (string? %) (u.date/parse %) %))
(update :parameter_mappings serdes/import-parameter-mappings)
(update :visualization_settings serdes/import-visualization-settings))) | |
(defn- dashboard-card-series-xform
[ingested]
(-> ingested
(update :card_id serdes/*import-fk* :model/Card)
(update :dashboardcard_id serdes/*import-fk* :model/DashboardCard))) | |
(defmethod serdes/load-one! "DashboardCard"
[ingested maybe-local]
(let [dashcard ((get-method serdes/load-one! :default) (dissoc ingested :series) maybe-local)]
;; drop all existing series for this card and recreate them
;; TODO: this is unnecessary, but it is simple to implement
(t2/delete! :model/DashboardCardSeries :dashboardcard_id (:id dashcard))
(doseq [[idx single-series] (map-indexed vector (:series ingested))] ;; a single series has a :card_id only
;; instead of load-one! we use load-insert! here because :serdes/meta isn't necessary because no other
;; entities depend on DashboardCardSeries
(serdes/load-insert! "DashboardCardSeries" (-> single-series
(assoc :dashboardcard_id (:entity_id dashcard)
:position idx)
dashboard-card-series-xform))))) | |
(ns metabase.models.dashboard-card-series (:require [methodical.core :as methodical] [toucan2.core :as t2])) | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all the DashboardCardSeries symbol in our codebase. | (def DashboardCardSeries :model/DashboardCardSeries) |
(methodical/defmethod t2/table-name :model/DashboardCardSeries [_model] :dashboardcard_series) | |
(doto :model/DashboardCardSeries (derive :metabase/model)) | |
(ns metabase.models.dashboard-tab (:require [medley.core :as m] [metabase.models.dashboard-card :as dashboard-card] [metabase.models.interface :as mi] [metabase.models.serialization :as serdes] [metabase.util :as u] [metabase.util.date-2 :as u.date] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [methodical.core :as methodical] [toucan2.core :as t2] [toucan2.tools.hydrate :as t2.hydrate])) | |
(methodical/defmethod t2/table-name :model/DashboardTab [_model] :dashboard_tab) | |
(doto :model/DashboardTab (derive :metabase/model) (derive ::mi/read-policy.full-perms-for-perms-set) (derive ::mi/write-policy.full-perms-for-perms-set) (derive :hook/timestamped?) (derive :hook/entity-id)) | |
(methodical/defmethod t2/model-for-automagic-hydration [:metabase.models.dashboard-card/DashboardCard :dashboard_tab] [_original-model _k] :model/DashboardTab) | |
(methodical/defmethod t2.hydrate/fk-keys-for-automagic-hydration [:metabase.models.dashboard-card/DashboardCard :dashboard_tab :default] [_original-model _dest-key _hydrating-model] [:dashboard_tab_id]) | |
(methodical/defmethod t2.hydrate/batched-hydrate [:default :tab-cards]
"Given a list of tabs, return a seq of ordered tabs, in which each tabs contain a seq of orderd cards."
[_model _k tabs]
(assert (= 1 (count (set (map :dashboard_id tabs)))), "All tabs must belong to the same dashboard")
(let [dashboard-id (:dashboard_id (first tabs))
tab-ids (map :id tabs)
dashcards (t2/select :model/DashboardCard :dashboard_id dashboard-id :dashboard_tab_id [:in tab-ids])
tab-id->dashcards (-> (group-by :dashboard_tab_id dashcards)
(update-vals #(sort dashboard-card/dashcard-comparator %)))
tabs (sort-by :position tabs)]
(for [{:keys [id] :as tab} tabs]
(assoc tab :cards (get tab-id->dashcards id))))) | |
(defmethod mi/perms-objects-set :model/DashboardTab
[dashtab read-or-write]
(let [dashboard (or (:dashboard dashtab)
(t2/select-one :model/Dashboard :id (:dashboard_id dashtab)))]
(mi/perms-objects-set dashboard read-or-write))) | |
----------------------------------------------- SERIALIZATION ---------------------------------------------------- | (defmethod serdes/hash-fields :model/DashboardTab
[_dashboard-tab]
[:name
(comp serdes/identity-hash
#(t2/select-one :model/Dashboard :id %)
:dashboard_id)
:position
:created_at]) |
DashboardTabs are not serialized as their own, separate entities. They are inlined onto their parent Dashboards. | (defmethod serdes/generate-path "DashboardTab" [_ dashcard] [(serdes/infer-self-path "Dashboard" (t2/select-one :model/Dashboard :id (:dashboard_id dashcard))) (serdes/infer-self-path "DashboardTab" dashcard)]) |
(defmethod serdes/load-xform "DashboardTab"
[dashtab]
(-> dashtab
(dissoc :serdes/meta)
(update :dashboard_id serdes/*import-fk* :model/Dashboard)
(update :created_at #(if (string? %) (u.date/parse %) %)))) | |
-------------------------------------------------- CRUD fns ------------------------------------------------------ | |
(mu/defn create-tabs! :- [:map-of neg-int? pos-int?]
"Create the new tabs and returned a mapping from temporary tab ID to the new tab ID."
[dashboard-id :- ms/PositiveInt
new-tabs :- [:sequential [:map [:id neg-int?]]]]
(let [new-tab-ids (t2/insert-returning-pks! :model/DashboardTab (->> new-tabs
(map #(dissoc % :id))
(map #(assoc % :dashboard_id dashboard-id))))]
(zipmap (map :id new-tabs) new-tab-ids))) | |
(mu/defn update-tabs! :- nil?
"Updates tabs of a dashboard if changed."
[current-tabs :- [:sequential [:map [:id ms/PositiveInt]]]
new-tabs :- [:sequential [:map [:id ms/PositiveInt]]]]
(let [update-ks [:name :position]
id->current-tab (m/index-by :id current-tabs)
to-update-tabs (filter
;; filter out tabs that haven't changed
(fn [new-tab]
(let [current-tab (get id->current-tab (:id new-tab))]
(not= (select-keys current-tab update-ks)
(select-keys new-tab update-ks))))
new-tabs)]
(doseq [tab to-update-tabs]
(t2/update! :model/DashboardTab (:id tab) (select-keys tab update-ks)))
nil)) | |
(mu/defn delete-tabs! :- nil?
"Delete tabs of a Dashboard"
[tab-ids :- [:sequential {:min 1} ms/PositiveInt]]
(when (seq tab-ids)
(t2/delete! :model/DashboardTab :id [:in tab-ids]))
nil) | |
Given current tabs and new tabs, do the necessary create/update/delete to apply new tab changes.
Returns:
- | (defn do-update-tabs!
[dashboard-id current-tabs new-tabs]
(let [{:keys [to-create
to-update
to-delete]} (u/classify-changes current-tabs new-tabs)
to-delete-ids (map :id to-delete)
_ (when-let [to-delete-ids (seq to-delete-ids)]
(delete-tabs! to-delete-ids))
old->new-tab-id (when (seq to-create)
(let [new-tab-ids (t2/insert-returning-pks! :model/DashboardTab
(->> to-create
(map #(dissoc % :id))
(map #(assoc % :dashboard_id dashboard-id))))]
(zipmap (map :id to-create) new-tab-ids)))]
(when (seq to-update)
(update-tabs! current-tabs to-update))
{:old->new-tab-id old->new-tab-id
:created-tab-ids (vals old->new-tab-id)
:deleted-tab-ids to-delete-ids
:total-num-tabs (reduce + (map count [to-create to-update]))})) |
(ns metabase.models.database (:require [medley.core :as m] [metabase.db.util :as mdb.u] [metabase.driver :as driver] [metabase.driver.impl :as driver.impl] [metabase.driver.util :as driver.u] [metabase.models.audit-log :as audit-log] [metabase.models.interface :as mi] [metabase.models.permissions :as perms] [metabase.models.permissions-group :as perms-group] [metabase.models.secret :as secret :refer [Secret]] [metabase.models.serialization :as serdes] [metabase.models.setting :as setting :refer [defsetting]] [metabase.plugins.classloader :as classloader] [metabase.public-settings.premium-features :as premium-features] [metabase.util :as u] [metabase.util.i18n :refer [deferred-tru trs]] [metabase.util.log :as log] [methodical.core :as methodical] [toucan2.core :as t2] [toucan2.realize :as t2.realize])) | |
----------------------------------------------- Entity & Lifecycle ----------------------------------------------- | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all Database symbols in our codebase. | (def Database :model/Database) |
(methodical/defmethod t2/table-name :model/Database [_model] :metabase_database) | |
(t2/deftransforms :model/Database
{:details mi/transform-encrypted-json
:engine mi/transform-keyword
:metadata_sync_schedule mi/transform-cron-string
:cache_field_values_schedule mi/transform-cron-string
:start_of_week mi/transform-keyword
:settings mi/transform-encrypted-json
:dbms_version mi/transform-json}) | |
(methodical/defmethod t2/model-for-automagic-hydration [:default :database] [_model _k] :model/Database) (methodical/defmethod t2/model-for-automagic-hydration [:default :db] [_model _k] :model/Database) | |
(doto :model/Database (derive :metabase/model) (derive ::mi/read-policy.partial-perms-for-perms-set) (derive ::mi/write-policy.full-perms-for-perms-set) (derive :hook/timestamped?)) | |
Audit Database should only be fetched if audit app is enabled. | (defn- should-read-audit-db? [database-id] (and (not (premium-features/enable-audit-app?)) (= database-id perms/audit-db-id))) |
(defmethod mi/can-read? Database
([instance]
(if (should-read-audit-db? (:id instance))
false
(mi/current-user-has-partial-permissions? :read instance)))
([model pk]
(if (should-read-audit-db? pk)
false
(mi/current-user-has-partial-permissions? :read model pk)))) | |
(defmethod mi/can-write? :model/Database
([instance]
(and (not= (u/the-id instance) perms/audit-db-id)
((get-method mi/can-write? ::mi/write-policy.full-perms-for-perms-set) instance)))
([model pk]
(and (not= pk perms/audit-db-id)
((get-method mi/can-write? ::mi/write-policy.full-perms-for-perms-set) model pk)))) | |
(Re)schedule sync operation tasks for | (defn- schedule-tasks!
[database]
(try
;; this is done this way to avoid circular dependencies
(classloader/require 'metabase.task.sync-databases)
((resolve 'metabase.task.sync-databases/check-and-schedule-tasks-for-db!) database)
(catch Throwable e
(log/error e (trs "Error scheduling tasks for DB"))))) |
TODO - something like NSNotificationCenter in Objective-C would be really really useful here so things that want to implement behavior when an object is deleted can do it without having to put code here | |
Unschedule any currently pending sync operation tasks for | (defn- unschedule-tasks!
[database]
(try
(classloader/require 'metabase.task.sync-databases)
((resolve 'metabase.task.sync-databases/unschedule-tasks-for-db!) database)
(catch Throwable e
(log/error e (trs "Error unscheduling tasks for DB."))))) |
(t2/define-after-insert :model/Database
[database]
(u/prog1 database
;; add this database to the All Users permissions group
(perms/grant-full-data-permissions! (perms-group/all-users) database)
;; give full download perms for this database to the All Users permissions group
(perms/grant-full-download-permissions! (perms-group/all-users) database)
;; schedule the Database sync & analyze tasks
(schedule-tasks! (t2.realize/realize database)))) | |
Track whether we're calling [[driver/normalize-db-details]] already to prevent infinite recursion. [[driver/normalize-db-details]] is actually done for side effects! | (def ^:private ^:dynamic *normalizing-details* false) |
(t2/define-after-select :model/Database
[{driver :engine, :as database}]
(letfn [(normalize-details [db]
(binding [*normalizing-details* true]
(driver/normalize-db-details driver db)))]
(cond-> database
;; TODO - this is only really needed for API responses. This should be a `hydrate` thing instead!
(driver.impl/registered? driver)
(assoc :features (driver.u/features driver database))
(and (driver.impl/registered? driver)
(:details database)
(not *normalizing-details*))
normalize-details))) | |
Delete Secret instances from the app DB, that will become orphaned when In the future, if/when we allow arbitrary association of secret instances to database instances, this will need to change and become more complicated (likely by consulting a many-to-many join table). | (defn- delete-orphaned-secrets!
[{:keys [id details] :as database}]
(when-let [conn-props-fn (get-method driver/connection-properties (driver.u/database->driver database))]
(let [conn-props (conn-props-fn (driver.u/database->driver database))
possible-secret-prop-names (keys (secret/conn-props->secret-props-by-name conn-props))]
(doseq [secret-id (reduce (fn [acc prop-name]
(if-let [secret-id (get details (keyword (str prop-name "-id")))]
(conj acc secret-id)
acc))
[]
possible-secret-prop-names)]
(log/info (trs "Deleting secret ID {0} from app DB because the owning database ({1}) is being deleted"
secret-id
id))
(t2/delete! Secret :id secret-id))))) |
(t2/define-before-delete :model/Database
[{id :id, driver :engine, :as database}]
(unschedule-tasks! database)
(t2/query-one {:delete-from :permissions
:where [:like :object (str "%" (perms/data-perms-path id) "%")]})
(delete-orphaned-secrets! database)
(try
(driver/notify-database-updated driver database)
(catch Throwable e
(log/error e (trs "Error sending database deletion notification"))))) | |
Helper fn for reducing over a map of all the secret connection-properties, keyed by name. This is side effecting. At each iteration step, if there is a -value suffixed property set in the details to be persisted, then we instead insert (or update an existing) Secret instance and point to the inserted -id instead. | (defn- handle-db-details-secret-prop!
[database details conn-prop-nm conn-prop]
(let [sub-prop (fn [suffix]
(keyword (str conn-prop-nm suffix)))
id-kw (sub-prop "-id")
value-kw (sub-prop "-value")
new-name (format "%s for %s" (:display-name conn-prop) (:name database))
kind (:secret-kind conn-prop)
;; in the future, when secret values can simply be changed by passing
;; in a new ID (as opposed to a new value), this behavior will change,
;; but for now, we should simply look for the value
secret-map (secret/db-details-prop->secret-map details conn-prop-nm)
value (:value secret-map)
src (:source secret-map)] ; set the :source due to the -path suffix (see above)]
(if (nil? value) ;; secret value for this conn prop was not changed
details
(let [{:keys [id] :as secret*} (secret/upsert-secret-value!
(id-kw details)
new-name
kind
src
value)]
(-> details
;; remove the -value keyword (since in the persisted details blob, we only ever want to store the -id),
;; but the value may be re-added by expand-inferred-secret-values below (if appropriate)
(dissoc value-kw (sub-prop "-path"))
(assoc id-kw id)
(secret/expand-inferred-secret-values conn-prop-nm conn-prop secret*)))))) |
(defn- handle-secrets-changes [{:keys [details] :as database}]
(if (map? details)
(let [updated-details (secret/reduce-over-details-secret-values
(driver.u/database->driver database)
details
(partial handle-db-details-secret-prop! database))]
(assoc database :details updated-details))
database)) | |
(t2/define-before-update :model/Database
[database]
(let [database (mi/pre-update-changes database)
{new-metadata-schedule :metadata_sync_schedule,
new-fieldvalues-schedule :cache_field_values_schedule,
new-engine :engine
new-settings :settings} database
{is-sample? :is_sample
old-metadata-schedule :metadata_sync_schedule
old-fieldvalues-schedule :cache_field_values_schedule
existing-settings :settings
existing-engine :engine
existing-name :name} (t2/original database)
new-engine (some-> new-engine keyword)]
(if (and is-sample?
new-engine
(not= new-engine existing-engine))
(throw (ex-info (trs "The engine on a sample database cannot be changed.")
{:status-code 400
:existing-engine existing-engine
:new-engine new-engine}))
(u/prog1 (-> database
(cond->
;; If the engine doesn't support nested field columns, `json_unfolding` must be nil
(and (some? (:details database))
(not (driver/database-supports? (or new-engine existing-engine) :nested-field-columns database)))
(update :details dissoc :json_unfolding))
handle-secrets-changes)
;; TODO - this logic would make more sense in post-update if such a method existed
;; if the sync operation schedules have changed, we need to reschedule this DB
(when (or new-metadata-schedule new-fieldvalues-schedule)
;; if one of the schedules wasn't passed continue using the old one
(let [new-metadata-schedule (or new-metadata-schedule old-metadata-schedule)
new-fieldvalues-schedule (or new-fieldvalues-schedule old-fieldvalues-schedule)]
(when (not= [new-metadata-schedule new-fieldvalues-schedule]
[old-metadata-schedule old-fieldvalues-schedule])
(log/info
(trs "{0} Database ''{1}'' sync/analyze schedules have changed!" existing-engine existing-name)
"\n"
(trs "Sync metadata was: ''{0}'' is now: ''{1}''" old-metadata-schedule new-metadata-schedule)
"\n"
(trs "Cache FieldValues was: ''{0}'', is now: ''{1}''" old-fieldvalues-schedule new-fieldvalues-schedule))
;; reschedule the database. Make sure we're passing back the old schedule if one of the two wasn't supplied
(schedule-tasks!
(assoc database
:metadata_sync_schedule new-metadata-schedule
:cache_field_values_schedule new-fieldvalues-schedule)))))
;; This maintains a constraint that if a driver doesn't support actions, it can never be enabled
;; If we drop support for actions for a driver, we'd need to add a migration to disable actions for all databases
(when (and (:database-enable-actions (or new-settings existing-settings))
(not (driver/database-supports? (or new-engine existing-engine) :actions database)))
(throw (ex-info (trs "The database does not support actions.")
{:status-code 400
:existing-engine existing-engine
:new-engine new-engine}))))))) | |
(t2/define-before-insert :model/Database
[{:keys [details initial_sync_status], :as database}]
(-> database
(cond->
(not details) (assoc :details {})
(not initial_sync_status) (assoc :initial_sync_status "incomplete"))
handle-secrets-changes)) | |
(defmethod mi/perms-objects-set :model/Database
[{db-id :id} read-or-write]
#{(case read-or-write
:read (perms/data-perms-path db-id)
:write (perms/db-details-write-perms-path db-id))}) | |
(defmethod serdes/hash-fields :model/Database [_database] [:name :engine]) | |
(defsetting persist-models-enabled (deferred-tru "Whether to enable models persistence for a specific Database.") :default false :type :boolean :visibility :public :database-local :only) | |
---------------------------------------------- Hydration / Util Fns ---------------------------------------------- | |
(mi/define-simple-hydration-method tables
:tables
"Return the `Tables` associated with this `Database`."
[{:keys [id]}]
;; TODO - do we want to include tables that should be `:hidden`?
(t2/select 'Table, :db_id id, :active true, {:order-by [[:%lower.display_name :asc]]})) | |
Return all the primary key | (defn pk-fields
[{:keys [id]}]
(let [table-ids (t2/select-pks-set 'Table, :db_id id, :active true)]
(when (seq table-ids)
(t2/select 'Field, :table_id [:in table-ids], :semantic_type (mdb.u/isa :type/PK))))) |
-------------------------------------------------- JSON Encoder -------------------------------------------------- | |
The string to replace passwords with when serializing Databases. | (def ^:const protected-password "**MetabasePass**") |
Gets all sensitive fields that should be redacted in API responses for a given database. Delegates to driver.u/sensitive-fields using the given database's driver (if valid), so refer to that for full details. If a valid driver can't be clearly determined, this simply returns the default set (driver.u/default-sensitive-fields). | (defn sensitive-fields-for-db
[database]
(if (and (some? database) (not-empty database))
(let [driver (driver.u/database->driver database)]
(if (some? driver)
(driver.u/sensitive-fields (driver.u/database->driver database))
driver.u/default-sensitive-fields))
driver.u/default-sensitive-fields)) |
(methodical/defmethod mi/to-json :model/Database
"When encoding a Database as JSON remove the `details` for any User without write perms for the DB.
Users with write perms can see the `details` but remove anything resembling a password. No one gets to see this in
an API response!
Also remove settings that the User doesn't have read perms for."
[db json-generator]
(next-method
(let [db (if (not (mi/can-write? db))
(dissoc db :details)
(update db :details (fn [details]
(reduce
#(m/update-existing %1 %2 (constantly protected-password))
details
(sensitive-fields-for-db db)))))]
(update db :settings (fn [settings]
(when (map? settings)
(m/filter-keys
(fn [setting-name]
(try
(setting/can-read-setting? setting-name
(setting/current-user-readable-visibilities))
(catch Throwable e
;; there is an known issue with exception is ignored when render API response (#32822)
;; If you see this error, you probably need to define a setting for `setting-name`.
;; But ideally, we should resovle the above issue, and remove this try/catch
(log/error e (format "Error checking the readability of %s setting. The setting will be hidden in API response." setting-name))
;; let's be conservative and hide it by defaults, if you want to see it,
;; you need to define it :)
false)))
settings)))))
json-generator)) | |
------------------------------------------------ Serialization ---------------------------------------------------- | |
(defmethod serdes/extract-one "Database"
[_model-name {:keys [include-database-secrets]} entity]
(-> (serdes/extract-one-basics "Database" entity)
(update :creator_id serdes/*export-user*)
(dissoc :features) ; This is a synthetic column that isn't in the real schema.
(cond-> (not include-database-secrets) (dissoc :details)))) | |
(defmethod serdes/entity-id "Database"
[_ {:keys [name]}]
name) | |
(defmethod serdes/generate-path "Database"
[_ {:keys [name]}]
[{:model "Database" :id name}]) | |
(defmethod serdes/load-find-local "Database"
[[{:keys [id]}]]
(t2/select-one Database :name id)) | |
(defmethod serdes/load-xform "Database"
[database]
(-> database
serdes/load-xform-basics
(update :creator_id serdes/*import-user*)
(assoc :initial_sync_status "complete"))) | |
(defmethod serdes/load-insert! "Database" [_ ingested]
(let [m (get-method serdes/load-insert! :default)]
(m "Database"
(if (:details ingested)
ingested
(assoc ingested :details {}))))) | |
(defmethod serdes/load-update! "Database" [_ ingested local]
(let [m (get-method serdes/load-update! :default)]
(m "Database"
(update ingested :details #(or % (:details local) {}))
local))) | |
(defmethod serdes/storage-path "Database" [{:keys [name]} _]
;; ["databases" "db_name" "db_name"] directory for the database with same-named file inside.
["databases" name name]) | |
(defmethod audit-log/model-details Database [database _event-type] (select-keys database [:id :name :engine])) | |
Dimensions are used to define remappings for Fields handled automatically when those Fields are encountered by the
Query Processor. For a more detailed explanation, refer to the documentation in
| (ns metabase.models.dimension (:require [metabase.models.interface :as mi] [metabase.models.serialization :as serdes] [metabase.util.date-2 :as u.date] [methodical.core :as methodical] [toucan2.core :as t2])) |
Possible values for Dimension.type : :internal :external | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase. | (def Dimension :model/Dimension) |
(methodical/defmethod t2/table-name :model/Dimension [_model] :dimension) | |
(doto :model/Dimension (derive :metabase/model) (derive :hook/entity-id) (derive :hook/timestamped?)) | |
(t2/deftransforms :model/Dimension
{:type mi/transform-keyword}) | |
(defmethod serdes/hash-fields :model/Dimension [_dimension] [(serdes/hydrated-hash :field) (serdes/hydrated-hash :human_readable_field) :created_at]) | |
------------------------------------------------- Serialization -------------------------------------------------- Dimensions are inlined onto their parent Fields. We can reuse the [[serdes/load-one!]] logic by implementing [[serdes/load-xform]] though. | (defmethod serdes/load-xform "Dimension"
[dim]
(-> dim
serdes/load-xform-basics
;; No need to handle :field_id, it was just added as the raw ID by the caller; see Field's load-one!
(update :human_readable_field_id serdes/*import-field-fk*)
(update :created_at u.date/parse))) |
Helpers to assist in the transition to Toucan 2. Once we switch to Toucan 2 this stuff shouldn't be needed, but we can update this namespace instead of having to update code all over the place. | (ns metabase.models.dispatch (:require [potemkin :as p] [schema.core :as s] [toucan2.core :as t2])) |
(p/import-vars [t2 instance instance-of? model]) | |
True if | (defn toucan-instance? [x] (t2/instance? x)) |
(defn ^:deprecated InstanceOf:Schema
"Helper for creating a schema to check whether something is an instance of `model`. Use this instead of of using the
`<Model>Instance` or calling [[type]] or [[class]] on a model yourself, since that won't work once we switch to
Toucan 2.
(s/defn my-fn :- (mi/InstanceOf:Schema User)
[]
...)
DEPRECATED: use [[InstanceOf]] and Malli instead."
[model]
(s/pred (fn [x]
(instance-of? model x))
(format "instance of a %s" (name model)))) | |
Helper for creating a Malli schema to check whether something is an instance of (mu/defn my-fn :- (mi/InstanceOf User) [] ...) | (defn InstanceOf
[model]
[:fn
{:error/message (format "instance of a %s" (name model))}
(partial instance-of? model)]) |
(ns metabase.models.field (:require [clojure.core.memoize :as memoize] [clojure.set :as set] [clojure.string :as str] [medley.core :as m] [metabase.db.connection :as mdb.connection] [metabase.lib.field :as lib.field] [metabase.lib.metadata.jvm :as lib.metadata.jvm] [metabase.models.dimension :refer [Dimension]] [metabase.models.field-values :as field-values :refer [FieldValues]] [metabase.models.humanization :as humanization] [metabase.models.interface :as mi] [metabase.models.permissions :as perms] [metabase.models.serialization :as serdes] [metabase.util :as u] [metabase.util.i18n :refer [trs tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [methodical.core :as methodical] [toucan2.core :as t2] [toucan2.tools.hydrate :as t2.hydrate])) | |
(set! *warn-on-reflection* true) | |
(comment mdb.connection/keep-me) ;; for [[memoize/ttl]] | |
for [[memoize/ttl]] | |
------------------------------------------------- Type Mappings -------------------------------------------------- | |
Possible values for | (def visibility-types
#{:normal ; Default setting. field has no visibility restrictions.
:details-only ; For long blob like columns such as JSON. field is not shown in some places on the frontend.
:hidden ; Lightweight hiding which removes field as a choice in most of the UI. should still be returned in queries.
:sensitive ; Strict removal of field from all places except data model listing. queries should error if someone attempts to access.
:retired}) ; For fields that no longer exist in the physical db. automatically set by Metabase. QP should error if encountered in a query. |
----------------------------------------------- Entity & Lifecycle ----------------------------------------------- | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all the Field symbol in our codebase. | (def Field :model/Field) |
(methodical/defmethod t2/table-name :model/Field [_model] :metabase_field) | |
(methodical/defmethod t2/model-for-automagic-hydration [:default :destination] [_model _k] :model/Field) (methodical/defmethod t2/model-for-automagic-hydration [:default :field] [_model _k] :model/Field) (methodical/defmethod t2/model-for-automagic-hydration [:default :origin] [_model _k] :model/Field) (methodical/defmethod t2/model-for-automagic-hydration [:default :human_readable_field] [_model _k] :model/Field) | |
(defn- hierarchy-keyword-in [column-name & {:keys [ancestor-types]}]
(fn [k]
(when-let [k (keyword k)]
(when-not (some
(partial isa? k)
ancestor-types)
(let [message (tru "Invalid value for Field column {0}: {1} is not a descendant of any of these types: {2}"
(pr-str column-name) (pr-str k) (pr-str ancestor-types))]
(throw (ex-info message
{:status-code 400
:errors {column-name message}
:value k
:allowed-ancestors ancestor-types}))))
(u/qualified-name k)))) | |
(defn- hierarchy-keyword-out [column-name & {:keys [fallback-type ancestor-types]}]
(fn [s]
(when (seq s)
(let [k (keyword s)]
(if (some
(partial isa? k)
ancestor-types)
k
(do
(log/warn (trs "Invalid Field {0} {1}: falling back to {2}" column-name k fallback-type))
fallback-type)))))) | |
(def ^:private transform-field-base-type
{:in (hierarchy-keyword-in :base_type :ancestor-types [:type/*])
:out (hierarchy-keyword-out :base_type :ancestor-types [:type/*], :fallback-type :type/*)}) | |
(def ^:private transform-field-effective-type
{:in (hierarchy-keyword-in :effective_type :ancestor-types [:type/*])
:out (hierarchy-keyword-out :effective_type :ancestor-types [:type/*], :fallback-type :type/*)}) | |
(def ^:private transform-field-semantic-type
{:in (hierarchy-keyword-in :semantic_type :ancestor-types [:Semantic/* :Relation/*])
:out (hierarchy-keyword-out :semantic_type :ancestor-types [:Semantic/* :Relation/*], :fallback-type nil)}) | |
(def ^:private transform-field-coercion-strategy
{:in (hierarchy-keyword-in :coercion_strategy :ancestor-types [:Coercion/*])
:out (hierarchy-keyword-out :coercion_strategy :ancestor-types [:Coercion/*], :fallback-type nil)}) | |
(defn- maybe-parse-semantic-numeric-values [maybe-double-value]
(if (string? maybe-double-value)
(or (u/ignore-exceptions (Double/parseDouble maybe-double-value)) maybe-double-value)
maybe-double-value)) | |
When fingerprinting decimal columns, NaN and Infinity values are possible. Serializing these values to JSON just yields a string, not a value double. This function will attempt to coerce any of those values to double objects | (defn- update-semantic-numeric-values
[fingerprint]
(m/update-existing-in fingerprint [:type :type/Number]
(partial m/map-vals maybe-parse-semantic-numeric-values))) |
(def ^:private transform-json-fingerprints
{:in mi/json-in
:out (comp update-semantic-numeric-values mi/json-out-with-keywordization)}) | |
(t2/deftransforms :model/Field
{:base_type transform-field-base-type
:effective_type transform-field-effective-type
:coercion_strategy transform-field-coercion-strategy
:semantic_type transform-field-semantic-type
:visibility_type mi/transform-keyword
:has_field_values mi/transform-keyword
:fingerprint transform-json-fingerprints
:settings mi/transform-json
:nfc_path mi/transform-json}) | |
(doto :model/Field (derive :metabase/model) (derive ::mi/read-policy.partial-perms-for-perms-set) (derive ::mi/write-policy.full-perms-for-perms-set) (derive :hook/timestamped?)) | |
(t2/define-before-insert :model/Field
[field]
(let [defaults {:display_name (humanization/name->human-readable-name (:name field))}]
(merge defaults field))) | |
(t2/define-before-update :model/Field
[field]
(u/prog1 (t2/changes field)
(when (false? (:active <>))
(t2/update! :model/Field {:fk_target_field_id (:id field)} {:semantic_type nil
:fk_target_field_id nil})))) | |
Field permissions There are several API endpoints where large instances can return many thousands of Fields. Normally Fields require a DB call to fetch information about their Table, because a Field's permissions set is the same as its parent Table's. To make API endpoints perform well, we have use two strategies: 1) If a Field's Table is already hydrated, there is no need to manually fetch the information a second time 2) Failing that, we cache the corresponding permissions sets for each Table ID for a few seconds to minimize the number of DB calls that are made. See discussion below for more details. | |
(defn- perms-objects-set*
[db-id schema table-id read-or-write]
#{(case read-or-write
:read (perms/data-perms-path db-id schema table-id)
:write (perms/data-model-write-perms-path db-id schema table-id))}) | |
Cached lookup for the permissions set for a table with Of course, no DB lookups are needed at all if the Field already has a hydrated Table. However, mistakes are possible, and I did not extensively audit every single code pathway that uses sequences of Fields and permissions, so this caching is added as a failsafe in case Table hydration wasn't done. Please note this only caches one entry PER TABLE ID. Thus, even a million Tables (which is more than I hope we ever see), would require only a few megs of RAM, and again only if every single Table was looked up in a span of 5 seconds. | (def ^:private ^{:arglists '([table-id read-or-write])} cached-perms-object-set
(memoize/ttl
^{::memoize/args-fn (fn [[table-id read-or-write]]
[(mdb.connection/unique-identifier) table-id read-or-write])}
(fn [table-id read-or-write]
(let [{schema :schema, db-id :db_id} (t2/select-one ['Table :schema :db_id] :id table-id)]
(perms-objects-set* db-id schema table-id read-or-write)))
:ttl/threshold 5000)) |
Calculate set of permissions required to access a Field. For the time being permissions to access a Field are the same as permissions to access its parent Table. | (defmethod mi/perms-objects-set :model/Field
[{table-id :table_id, {db-id :db_id, schema :schema} :table} read-or-write]
(if db-id
;; if Field already has a hydrated `:table`, then just use that to generate perms set (no DB calls required)
(perms-objects-set* db-id schema table-id read-or-write)
;; otherwise we need to fetch additional info about Field's Table. This is cached for 5 seconds (see above)
(cached-perms-object-set table-id read-or-write))) |
(defmethod serdes/hash-fields :model/Field [_field] [:name (serdes/hydrated-hash :table)]) | |
---------------------------------------------- Hydration / Util Fns ---------------------------------------------- | |
Return the | (defn values
[{:keys [id]}]
(t2/select [FieldValues :field_id :values], :field_id id)) |
(mu/defn nested-field-names->field-id :- [:maybe ms/PositiveInt]
"Recusively find the field id for a nested field name, return nil if not found.
Nested field here refer to a field that has another field as its parent_id, like nested field in Mongo DB.
This is to differentiate from the json nested field in, which the path is defined in metabase_field.nfc_path."
[table-id :- ms/PositiveInt
field-names :- [:sequential ms/NonBlankString]]
(loop [field-names field-names
field-id nil]
(if (seq field-names)
(let [field-name (first field-names)
field-id (t2/select-one-pk :model/Field :name field-name :parent_id field-id :table_id table-id)]
(if field-id
(recur (rest field-names) field-id)
nil))
field-id))) | |
Select instances of (select-field-id->instance [(Field 1) (Field 2)] FieldValues) ;; -> {1 #FieldValues{...}, 2 #FieldValues{...}} (select-field-id->instance [(Field 1) (Field 2)] FieldValues :type :full) -> returns Fieldvalues of type :full for fields: [(Field 1) (Field 2)] | (defn- select-field-id->instance
[fields model & conditions]
(let [field-ids (set (map :id fields))]
(m/index-by :field_id (when (seq field-ids)
(apply t2/select model :field_id [:in field-ids] conditions))))) |
(mi/define-batched-hydration-method with-values
:values
"Efficiently hydrate the `FieldValues` for a collection of `fields`."
[fields]
;; In 44 we added a new concept of Advanced FieldValues, so FieldValues are no longer have an one-to-one relationship
;; with Field. See the doc in [[metabase.models.field-values]] for more.
;; Adding an explicity filter by :type =:full for FieldValues here bc I believe this hydration does not concern
;; the new Advanced FieldValues.
(let [id->field-values (select-field-id->instance fields FieldValues :type :full)]
(for [field fields]
(assoc field :values (get id->field-values (:id field) []))))) | |
(mi/define-batched-hydration-method with-normal-values
:normal_values
"Efficiently hydrate the `FieldValues` for visibility_type normal `fields`."
[fields]
(let [id->field-values (select-field-id->instance (filter field-values/field-should-have-field-values? fields)
[FieldValues :id :human_readable_values :values :field_id]
:type :full)]
(for [field fields]
(assoc field :values (get id->field-values (:id field) []))))) | |
(mi/define-batched-hydration-method with-dimensions
:dimensions
"Efficiently hydrate the `Dimension` for a collection of `fields`.
NOTE! Despite the name, this only returns at most one dimension. This is for historic reasons; see #13350 for more
details.
Despite the weirdness, this used to be even worse -- due to a bug in the code, this originally returned a *map* if
there was a matching Dimension, or an empty vector if there was not. In 0.46.0 I fixed this to return either a
vector with the matching Dimension, or an empty vector. At least the response shape is consistent now. Maybe in the
future we can change this key to `:dimension` and return it that way. -- Cam"
[fields]
(let [id->dimensions (select-field-id->instance fields Dimension)]
(for [field fields
:let [dimension (get id->dimensions (:id field))]]
(assoc field :dimensions (if dimension [dimension] []))))) | |
(methodical/defmethod t2.hydrate/simple-hydrate [#_model :default #_k :has_field_values]
"Infer what the value of the `has_field_values` should be for Fields where it's not set. See documentation for
[[metabase.lib.schema.metadata/column-has-field-values-options]] for a more detailed explanation of what these
values mean.
This does one important thing: if `:has_field_values` is already present and set to `:auto-list`, it is replaced by
`:list` -- presumably because the frontend doesn't need to know `:auto-list` even exists?
See [[lib.field/infer-has-field-values]] for more info."
[_model k field]
(when field
(let [has-field-values (lib.field/infer-has-field-values (lib.metadata.jvm/instance->metadata field :metadata/column))]
(assoc field k has-field-values)))) | |
(methodical/defmethod t2.hydrate/needs-hydration? [#_model :default #_k :has_field_values] "Always (re-)hydrate `:has_field_values`. This is used to convert an existing value of `:auto-list` to `:list` (see [[infer-has-field-values]])." [_model _k _field] true) | |
Efficiently checks if each field is readable and returns only readable fields | (defn readable-fields-only
[fields]
(for [field (t2/hydrate fields :table)
:when (mi/can-read? field)]
(dissoc field :table))) |
(mi/define-batched-hydration-method with-targets
:target
"Efficiently hydrate the FK target fields for a collection of `fields`."
[fields]
(let [target-field-ids (set (for [field fields
:when (and (isa? (:semantic_type field) :type/FK)
(:fk_target_field_id field))]
(:fk_target_field_id field)))
id->target-field (m/index-by :id (when (seq target-field-ids)
(readable-fields-only (t2/select Field :id [:in target-field-ids]))))]
(for [field fields
:let [target-id (:fk_target_field_id field)]]
(assoc field :target (id->target-field target-id))))) | |
Hydrates :target on field, but if the | (defn hydrate-target-with-write-perms
[field]
(let [target-field-id (when (isa? (:semantic_type field) :type/FK)
(:fk_target_field_id field))
target-field (when-let [target-field (and target-field-id (t2/select-one Field :id target-field-id))]
(when (mi/can-write? (t2/hydrate target-field :table))
target-field))]
(assoc field :target target-field))) |
Return the pieces that represent a path to | (defn qualified-name-components
[{field-name :name, table-id :table_id, parent-id :parent_id}]
(conj (vec (if-let [parent (t2/select-one Field :id parent-id)]
(qualified-name-components parent)
(let [{table-name :name, schema :schema} (t2/select-one ['Table :name :schema], :id table-id)]
(conj (when schema
[schema])
table-name))))
field-name)) |
Return a combined qualified name for | (defn qualified-name [field] (str/join \. (qualified-name-components field))) |
Return the ID of the Table this Field belongs to. | (def ^{:arglists '([field-id])} field-id->table-id
(mdb.connection/memoize-for-application-db
(fn [field-id]
{:pre [(integer? field-id)]}
(t2/select-one-fn :table_id Field, :id field-id)))) |
Return the ID of the Database this Field belongs to. | (defn field-id->database-id
[field-id]
{:pre [(integer? field-id)]}
(let [table-id (field-id->table-id field-id)]
((requiring-resolve 'metabase.models.table/table-id->database-id) table-id))) |
Return the | (defn table
{:arglists '([field])}
[{:keys [table_id]}]
(t2/select-one 'Table, :id table_id)) |
------------------------------------------------- Serialization ------------------------------------------------- | |
In order to retrieve the dependencies for a field its table_id needs to be serialized as [database schema table], a trio of strings with schema maybe nil. | (defmethod serdes/generate-path "Field" [_ {table_id :table_id field :name}]
(let [table (when (number? table_id)
(t2/select-one 'Table :id table_id))
db (when table
(t2/select-one-fn :name 'Database :id (:db_id table)))
[db schema table] (if (number? table_id)
[db (:schema table) (:name table)]
;; If table_id is not a number, it's already been exported as a [db schema table] triple.
table_id)]
(filterv some? [{:model "Database" :id db}
(when schema {:model "Schema" :id schema})
{:model "Table" :id table}
{:model "Field" :id field}]))) |
(defmethod serdes/entity-id "Field" [_ {:keys [name]}]
name) | |
(defmethod serdes/extract-query "Field" [_model-name _opts]
(let [d (t2/select Dimension)
dimensions (->> d
(group-by :field_id))]
(eduction (map #(assoc % :dimensions (get dimensions (:id %))))
(t2/reducible-select Field)))) | |
(defmethod serdes/dependencies "Field" [field]
;; Fields depend on their parent Table, plus any foreign Fields referenced by their Dimensions.
;; Take the path, but drop the Field section to get the parent Table's path instead.
(let [this (serdes/path field)
table (pop this)
fks (some->> field :fk_target_field_id serdes/field->path)
human (->> (:dimensions field)
(keep :human_readable_field_id)
(map serdes/field->path)
set)]
(cond-> (set/union #{table} human)
fks (set/union #{fks})
true (disj this)))) | |
(defn- extract-dimensions [dimensions]
(->> (for [dim dimensions]
(-> (into (sorted-map) dim)
(dissoc :field_id :updated_at) ; :field_id is implied by the nesting under that field.
(update :human_readable_field_id serdes/*export-field-fk*)))
(sort-by :created_at))) | |
(defmethod serdes/extract-one "Field"
[_model-name _opts field]
(let [field (if (contains? field :dimensions)
field
(assoc field :dimensions (t2/select Dimension :field_id (:id field))))]
(-> (serdes/extract-one-basics "Field" field)
(update :dimensions extract-dimensions)
(update :table_id serdes/*export-table-fk*)
(update :fk_target_field_id serdes/*export-field-fk*)
(dissoc :fingerprint :last_analyzed :fingerprint_version)))) | |
(defmethod serdes/load-xform "Field"
[field]
(-> (serdes/load-xform-basics field)
(update :table_id serdes/*import-table-fk*)
(update :fk_target_field_id serdes/*import-field-fk*))) | |
(defmethod serdes/load-find-local "Field"
[path]
(let [table (serdes/load-find-local (pop path))]
(t2/select-one Field :name (-> path last :id) :table_id (:id table)))) | |
(defmethod serdes/load-one! "Field" [ingested maybe-local]
(let [field ((get-method serdes/load-one! :default) (dissoc ingested :dimensions) maybe-local)]
(doseq [dim (:dimensions ingested)]
(let [local (t2/select-one Dimension :entity_id (:entity_id dim))
dim (assoc dim
:field_id (:id field)
:serdes/meta [{:model "Dimension" :id (:entity_id dim)}])]
(serdes/load-one! dim local))))) | |
(defmethod serdes/storage-path "Field" [field _]
(-> field
serdes/path
drop-last
serdes/storage-table-path-prefix
(concat ["fields" (:name field)]))) | |
FieldValues is used to store a cached list of values of Fields that has There are 2 main classes of FieldValues: Full and Advanced. - Full FieldValues store a list of distinct values of a Field without any constraints. - Whereas Advanced FieldValues has additional constraints: - sandbox: FieldValues of a field but is sandboxed for a specific user - linked-filter: FieldValues for a param that connects to a Field that is constrained by the values of other Field. It's currently being used on Dashboard or Embedding, but it could be used to power any parameters that connect to a Field.
There is also more written about how these are used for remapping in the docstrings for [[metabase.models.params.chain-filter]] and [[metabase.query-processor.middleware.add-dimension-projections]]. | (ns metabase.models.field-values (:require [java-time.api :as t] [malli.core :as mc] [medley.core :as m] [metabase.models.interface :as mi] [metabase.models.serialization :as serdes] [metabase.plugins.classloader :as classloader] [metabase.public-settings.premium-features :refer [defenterprise]] [metabase.util :as u] [metabase.util.date-2 :as u.date] [metabase.util.i18n :refer [trs tru]] [metabase.util.log :as log] [metabase.util.malli.schema :as ms] [methodical.core :as methodical] [toucan2.core :as t2])) |
Fields with less than this many distinct values should automatically be given a semantic type of | (def ^Long category-cardinality-threshold 30) |
Fields with less than this many distincy values should be given a | (def ^Long auto-list-cardinality-threshold 1000) |
The maximum character length for a stored FieldValues entry. | (def ^:private ^Long entry-max-length 100) |
Maximum total length for a FieldValues entry (combined length of all values for the field). | (def ^:dynamic ^Long *total-max-length* (long (* auto-list-cardinality-threshold entry-max-length))) |
Age of an advanced FieldValues in days.
After this time, these field values should be deleted by the | (def ^java.time.Period advanced-field-values-max-age (t/days 30)) |
How many days until a FieldValues is considered inactive. Inactive FieldValues will not be synced until they are used again. | (def ^:private ^java.time.Period active-field-values-cutoff (t/days 14)) |
A class of fieldvalues that has additional constraints/filters. | (def advanced-field-values-types
#{:sandbox ;; field values filtered by sandbox permissions
:impersonation ;; field values with connection impersonation enforced (db-level roles)
:linked-filter}) ;; field values with constraints from other linked parameters on dashboard/embedding |
field values with constraints from other linked parameters on dashboard/embedding | |
All FieldValues type. | (def ^:private field-values-types
(into #{:full} ;; default type for fieldvalues where it contains values for a field without constraints
advanced-field-values-types)) |
+----------------------------------------------------------------------------------------------------------------+ | Entity & Lifecycle | +----------------------------------------------------------------------------------------------------------------+ | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase. | (def FieldValues :model/FieldValues) |
(methodical/defmethod t2/table-name :model/FieldValues [_model] :metabase_fieldvalues) | |
(doto :model/FieldValues (derive :metabase/model) (derive :hook/timestamped?)) | |
(t2/deftransforms :model/FieldValues
{:human_readable_values mi/transform-json-no-keywordization
:values mi/transform-json
:type mi/transform-keyword}) | |
(defn- assert-valid-human-readable-values [{human-readable-values :human_readable_values}]
(when-not (mc/validate [:maybe [:sequential [:maybe ms/NonBlankString]]] human-readable-values)
(throw (ex-info (tru "Invalid human-readable-values: values must be a sequence; each item must be nil or a string")
{:human-readable-values human-readable-values
:status-code 400})))) | |
(defn- assert-valid-field-values-type
[{:keys [type hash_key] :as _field-values}]
(when type
(when-not (contains? field-values-types type)
(throw (ex-info (tru "Invalid field-values type.")
{:type type
:stauts-code 400})))
(when (and (= type :full)
hash_key)
(throw (ex-info (tru "Full FieldValues shouldn't have hash_key.")
{:type type
:hash_key hash_key
:status-code 400})))
(when (and (advanced-field-values-types type)
(empty? hash_key))
(throw (ex-info (tru "Advanced FieldValues requires a hash_key.")
{:type type
:status-code 400}))))) | |
Remove all advanced FieldValues for a | (defn clear-advanced-field-values-for-field!
[field-or-id]
(t2/delete! FieldValues :field_id (u/the-id field-or-id)
:type [:in advanced-field-values-types])) |
Remove all FieldValues for a | (defn clear-field-values-for-field! [field-or-id] (t2/delete! FieldValues :field_id (u/the-id field-or-id))) |
(t2/define-before-insert :model/FieldValues
[{:keys [field_id] :as field-values}]
(u/prog1 (merge {:type :full}
field-values)
(assert-valid-human-readable-values field-values)
(assert-valid-field-values-type field-values)
;; if inserting a new full fieldvalues, make sure all the advanced field-values of this field is deleted
(when (= (:type <>) :full)
(clear-advanced-field-values-for-field! field_id)))) | |
(t2/define-before-update :model/FieldValues
[field-values]
(let [{:keys [type values hash_key]} (t2/changes field-values)]
(u/prog1 field-values
(assert-valid-human-readable-values field-values)
(when (or type hash_key)
(throw (ex-info (tru "Can't update type or hash_key for a FieldValues.")
{:type type
:hash_key hash_key
:status-code 400})))
;; if we're updating the values of a Full FieldValues, delete all Advanced FieldValues of this field
(when (and values
(= (:type field-values) :full))
(clear-advanced-field-values-for-field! (:field_id field-values)))))) | |
(t2/define-after-select :model/FieldValues
[field-values]
(cond-> field-values
(contains? field-values :human_readable_values)
(update :human_readable_values (fn [human-readable-values]
(cond
(sequential? human-readable-values)
human-readable-values
;; in some places human readable values were incorrectly saved as a map. If
;; that's the case, convert them back to a sequence
(map? human-readable-values)
(do
(assert (:values field-values)
(tru ":values must be present to fetch :human_readable_values"))
(mapv human-readable-values (:values field-values)))
;; if the `:human_readable_values` key is present (i.e., if we are fetching the
;; whole row), but `nil`, then replace the `nil` value with an empty vector. The
;; client likes this better.
:else
[]))))) | |
(defmethod serdes/hash-fields :model/FieldValues [_field-values] [(serdes/hydrated-hash :field)]) | |
+----------------------------------------------------------------------------------------------------------------+ | Utils fns | +----------------------------------------------------------------------------------------------------------------+ | |
If FieldValues have not been accessed recently they are considered inactive. | (defn inactive?
[field-values]
(and field-values (t/before? (:last_used_at field-values)
(t/minus (t/offset-date-time) active-field-values-cutoff)))) |
Should this | (defn field-should-have-field-values?
[field-or-field-id]
(if-not (map? field-or-field-id)
(let [field-id (u/the-id field-or-field-id)]
(recur (or (t2/select-one ['Field :base_type :visibility_type :has_field_values] :id field-id)
(throw (ex-info (tru "Field {0} does not exist." field-id)
{:field-id field-id, :status-code 404})))))
(let [{base-type :base_type
visibility-type :visibility_type
has-field-values :has_field_values} field-or-field-id]
(boolean
(and
(not (contains? #{:retired :sensitive :hidden :details-only} (keyword visibility-type)))
(not (isa? (keyword base-type) :type/Temporal))
(#{:list :auto-list} (keyword has-field-values))))))) |
Like ;; (take-by-length 6 [["Dog"] ["Cat"] ["Duck"]]) ;; => [["Dog"] ["Cat"]] | (defn take-by-length
([max-length]
(fn [rf]
(let [current-length (volatile! 0)]
(fn
([] (rf))
([result]
(rf result))
([result input]
(vswap! current-length + (count (str (first input))))
(if (< @current-length max-length)
(rf result input)
(reduced result)))))))
([max-length coll]
(lazy-seq
(when-let [s (seq coll)]
(let [f (first s)
new-length (- max-length (count (str (first f))))]
(when-not (neg? new-length)
(cons f (take-by-length new-length
(rest s))))))))) |
Field values and human readable values are lists that are zipped together. If the field values have changed, the
human readable values will need to change too. This function reconstructs the | (defn fixup-human-readable-values
[{old-values :values, old-hrv :human_readable_values} new-values]
(when (seq old-hrv)
(let [orig-remappings (zipmap old-values old-hrv)]
(map #(get orig-remappings % (str %)) new-values)))) |
Returns a list of pairs (or single element vectors if there are no humanreadablevalues) for the given
| (defn field-values->pairs
[{:keys [values human_readable_values]}]
(if (seq human_readable_values)
(map vector values human_readable_values)
(map vector values))) |
+----------------------------------------------------------------------------------------------------------------+ | Advanced FieldValues | +----------------------------------------------------------------------------------------------------------------+ | |
Checks if an advanced FieldValues expired. | (defn advanced-field-values-expired?
[fv]
{:pre [(advanced-field-values-types (:type fv))]}
(u.date/older-than? (:created_at fv) advanced-field-values-max-age)) |
Return a hash-key that will be used for sandboxed fieldvalues. | (defenterprise hash-key-for-sandbox metabase-enterprise.sandbox.models.params.field-values [_field-id] nil) |
Return a hash-key that will be used for impersonated fieldvalues. | (defenterprise hash-key-for-impersonation metabase-enterprise.advanced-permissions.driver.impersonation [_field-id] nil) |
OSS impl of [[hash-key-for-linked-filters]]. | (defn default-hash-key-for-linked-filters
[field-id constraints]
(str (hash [field-id
constraints]))) |
Return a hash-key that will be used for linked-filters fieldvalues. | (defenterprise hash-key-for-linked-filters metabase-enterprise.sandbox.models.params.field-values [field-id constraints] (default-hash-key-for-linked-filters field-id constraints)) |
+----------------------------------------------------------------------------------------------------------------+ | CRUD fns | +----------------------------------------------------------------------------------------------------------------+ | |
Fetch a sequence of distinct values for ;; (distinct-values (Field 1)) ;; -> {:values [[1], [2], [3]] :hasmorevalues false} (This function provides the values that normally get saved as a Field's FieldValues. You most likely should not be using this directly in code outside of this namespace, unless it's for a very specific reason, such as certain cases where we fetch ad-hoc FieldValues for GTAP-filtered Fields.) | (defn distinct-values
[field]
(classloader/require 'metabase.db.metadata-queries)
(try
(let [distinct-values ((resolve 'metabase.db.metadata-queries/field-distinct-values) field)
limited-distinct-values (take-by-length *total-max-length* distinct-values)]
{:values limited-distinct-values
;; has_more_values=true means the list of values we return is a subset of all possible values.
:has_more_values (or
;; If the `distinct-values` has more elements than `limited-distinct-values`
;; it means the the `distinct-values` has exceeded our [[*total-max-length*]] limits.
(> (count distinct-values)
(count limited-distinct-values))
;; [[metabase.db.metadata-queries/field-distinct-values]] runs a query
;; with limit = [[metabase.db.metadata-queries/absolute-max-distinct-values-limit]].
;; So, if the returned `distinct-values` has length equal to that exact limit,
;; we assume the returned values is just a subset of what we have in DB.
(= (count distinct-values)
@(resolve 'metabase.db.metadata-queries/absolute-max-distinct-values-limit)))})
(catch Throwable e
(log/error e (trs "Error fetching field values"))
nil))) |
Create or update the full FieldValues object for Note that if the full FieldValues are create/updated/deleted, it'll delete all the Advanced FieldValues of the same | (defn create-or-update-full-field-values!
[field & [human-readable-values]]
(let [field-values (t2/select-one FieldValues :field_id (u/the-id field) :type :full)
{unwrapped-values :values
:keys [has_more_values]} (distinct-values field)
;; unwrapped-values are 1-tuples, so we need to unwrap their values for storage
values (map first unwrapped-values)
field-name (or (:name field) (:id field))]
(cond
;; If this Field is marked `auto-list`, and the number of values in now over
;; the [[auto-list-cardinality-threshold]] or the accumulated length of all values exceeded
;; the [[*total-max-length*]] threshold we need to unmark it as `auto-list`. Switch it to `has_field_values` =
;; `nil` and delete the FieldValues; this will result in it getting a Search Widget in the UI when
;; `has_field_values` is automatically inferred by the [[metabase.models.field/infer-has-field-values]] hydration
;; function (see that namespace for more detailed discussion)
;;
;; It would be nicer if we could do this in analysis where it gets marked `:auto-list` in the first place, but
;; Fingerprints don't get updated regularly enough that we could detect the sudden increase in cardinality in a
;; way that could make this work. Thus, we are stuck doing it here :(
(and (= :auto-list (keyword (:has_field_values field)))
(or has_more_values
(> (count values) auto-list-cardinality-threshold)))
(do
(log/info (trs "Field {0} was previously automatically set to show a list widget, but now has {1} values."
field-name (count values))
(trs "Switching Field to use a search widget instead."))
(t2/update! 'Field (u/the-id field) {:has_field_values nil})
(clear-field-values-for-field! field)
::fv-deleted)
(and (= (:values field-values) values)
(= (:has_more_values field-values) has_more_values))
(do
(log/debug (trs "FieldValues for Field {0} remain unchanged. Skipping..." field-name))
::fv-skipped)
;; if the FieldValues object already exists then update values in it
(and field-values unwrapped-values)
(do
(log/debug (trs "Storing updated FieldValues for Field {0}..." field-name))
(t2/update! FieldValues (u/the-id field-values)
(m/remove-vals nil?
{:has_more_values has_more_values
:values values
:human_readable_values (fixup-human-readable-values field-values values)}))
::fv-updated)
;; if FieldValues object doesn't exist create one
unwrapped-values
(do
(log/debug (trs "Storing FieldValues for Field {0}..." field-name))
(t2/insert! FieldValues
:type :full
:field_id (u/the-id field)
:has_more_values has_more_values
:values values
:human_readable_values human-readable-values)
::fv-created)
;; otherwise this Field isn't eligible, so delete any FieldValues that might exist
:else
(do
(clear-field-values-for-field! field)
::fv-deleted)))) |
Create FieldValues for a | (defn get-or-create-full-field-values!
{:arglists '([field] [field human-readable-values])}
[{field-id :id field-values :values :as field} & [human-readable-values]]
{:pre [(integer? field-id)]}
(when (field-should-have-field-values? field)
(let [existing (or (not-empty field-values)
(t2/select-one FieldValues :field_id field-id :type :full))]
(if (or (not existing) (inactive? existing))
(case (create-or-update-full-field-values! field human-readable-values)
::fv-deleted
nil
::fv-created
(t2/select-one FieldValues :field_id field-id :type :full)
(do
(when existing
(t2/update! FieldValues (:id existing) {:last_used_at :%now}))
(t2/select-one FieldValues :field_id field-id :type :full)))
(do
(t2/update! FieldValues (:id existing) {:last_used_at :%now})
existing))))) |
+----------------------------------------------------------------------------------------------------------------+ | On Demand | +----------------------------------------------------------------------------------------------------------------+ | |
Given a collection of | (defn- table-ids->table-id->is-on-demand?
[table-ids]
(let [table-ids (set table-ids)
table-id->db-id (when (seq table-ids)
(t2/select-pk->fn :db_id 'Table :id [:in table-ids]))
db-id->is-on-demand? (when (seq table-id->db-id)
(t2/select-pk->fn :is_on_demand 'Database
:id [:in (set (vals table-id->db-id))]))]
(into {} (for [table-id table-ids]
[table-id (-> table-id table-id->db-id db-id->is-on-demand?)])))) |
Update the FieldValues for any Fields with | (defn update-field-values-for-on-demand-dbs!
[field-ids]
(let [fields (when (seq field-ids)
(filter field-should-have-field-values?
(t2/select ['Field :name :id :base_type :effective_type :coercion_strategy
:semantic_type :visibility_type :table_id :has_field_values]
:id [:in field-ids])))
table-id->is-on-demand? (table-ids->table-id->is-on-demand? (map :table_id fields))]
(doseq [{table-id :table_id, :as field} fields]
(when (table-id->is-on-demand? table-id)
(log/debug
(trs "Field {0} ''{1}'' should have FieldValues and belongs to a Database with On-Demand FieldValues updating."
(u/the-id field) (:name field)))
(create-or-update-full-field-values! field))))) |
+----------------------------------------------------------------------------------------------------------------+ | Serialization | +----------------------------------------------------------------------------------------------------------------+ | (defmethod serdes/generate-path "FieldValues" [_ {:keys [field_id]}]
(let [field (t2/select-one 'Field :id field_id)]
(conj (serdes/generate-path "Field" field)
{:model "FieldValues" :id "0"}))) |
(defmethod serdes/dependencies "FieldValues" [fv] ;; Take the path, but drop the FieldValues section at the end, to get the parent Field's path instead. [(pop (serdes/path fv))]) | |
(defmethod serdes/extract-one "FieldValues" [_model-name _opts fv]
(-> (serdes/extract-one-basics "FieldValues" fv)
(dissoc :field_id))) | |
(defmethod serdes/load-xform "FieldValues" [fv]
(let [[db schema table field :as field-ref] (map :id (pop (serdes/path fv)))
field-ref (if field
field-ref
;; It's too short, so no schema. Shift them over and add a nil schema.
[db nil schema table])]
(-> (serdes/load-xform-basics fv)
(assoc :field_id (serdes/*import-field-fk* field-ref))
(update :type keyword)))) | |
(defmethod serdes/load-find-local "FieldValues" [path]
;; Delegate to finding the parent Field, then look up its corresponding FieldValues.
(let [field (serdes/load-find-local (pop path))]
(t2/select-one FieldValues :field_id (:id field)))) | |
(defmethod serdes/load-update! "FieldValues" [_ ingested local]
;; It's illegal to change the :type and :hash_key fields, and there's a pre-update check for this.
;; This drops those keys from the incoming FieldValues iff they match the local one. If they are actually different,
;; this preserves the new value so the normal error is produced.
(let [ingested (cond-> ingested
(= (:type ingested) (:type local)) (dissoc :type)
(= (:hash_key ingested) (:hash_key local)) (dissoc :hash_key))]
((get-method serdes/load-update! "") "FieldValues" ingested local))) | |
(def ^:private field-values-slug "___fieldvalues") | |
(defmethod serdes/storage-path "FieldValues" [fv _]
;; [path to table "fields" "field-name___fieldvalues"] since there's zero or one FieldValues per Field, and Fields
;; don't have their own directories.
(let [hierarchy (serdes/path fv)
field (last (drop-last hierarchy))
table-prefix (serdes/storage-table-path-prefix (drop-last 2 hierarchy))]
(concat table-prefix
["fields" (str (:id field) field-values-slug)]))) | |
Logic related to humanization of table names and other identifiers, e.g. taking an identifier like There are currently two implementations of humanization logic, previously three.
Which implementation is used is determined by the Setting There used to also be | (ns metabase.models.humanization (:require [metabase.models.setting :as setting :refer [defsetting]] [metabase.util :as u] [metabase.util.humanization :as u.humanization] [metabase.util.i18n :refer [deferred-tru trs tru]] [metabase.util.log :as log] [schema.core :as s] [toucan2.core :as t2])) |
(declare humanization-strategy) | |
Convert a name, such as (humanization-strategy! :simple) (name->human-readable-name "cool_toucans") ;-> "Cool Toucans" ;; this is the same as: (name->human-readable-name (humanization-strategy) "cool_toucans") ;-> "Cool Toucans" ;; specifiy a different strategy: (name->human-readable-name :none "cooltoucans") ;-> "cooltoucans" | (defn name->human-readable-name ([s] (name->human-readable-name (humanization-strategy) s)) ([strategy s] (u.humanization/name->human-readable-name strategy s))) |
Update all non-custom display names of all instances of | (defn- re-humanize-names!
[old-strategy model]
(run! (fn [{id :id, internal-name :name, display-name :display_name}]
(let [old-strategy-display-name (name->human-readable-name old-strategy internal-name)
new-strategy-display-name (name->human-readable-name internal-name)
custom-display-name? (not= old-strategy-display-name display-name)]
(when (and (not= display-name new-strategy-display-name)
(not custom-display-name?))
(log/info (trs "Updating display name for {0} ''{1}'': ''{2}'' -> ''{3}''"
(name model) internal-name display-name new-strategy-display-name))
(t2/update! model id
{:display_name new-strategy-display-name}))))
(t2/reducible-select [model :id :name :display_name]))) |
Update the non-custom display names of all Tables & Fields in the database using new values obtained from
the (obstensibly swapped implementation of) | (s/defn ^:private re-humanize-table-and-field-names!
[old-strategy :- s/Keyword]
(doseq [model ['Table 'Field]]
(re-humanize-names! old-strategy model))) |
(defn- set-humanization-strategy! [new-value]
(let [new-strategy (keyword (or new-value :simple))]
;; check to make sure `new-strategy` is a valid strategy, or throw an Exception it is it not.
(when-not (get-method u.humanization/name->human-readable-name new-strategy)
(throw (IllegalArgumentException.
(tru "Invalid humanization strategy ''{0}''. Valid strategies are: {1}"
new-strategy (keys (methods u.humanization/name->human-readable-name))))))
(let [old-strategy (setting/get-value-of-type :keyword :humanization-strategy)]
;; ok, now set the new value
(setting/set-value-of-type! :keyword :humanization-strategy new-value)
;; now rehumanize all the Tables and Fields using the new strategy.
;; TODO: Should we do this in a background thread because it is potentially slow?
(log/info (trs "Changing Table & Field names humanization strategy from ''{0}'' to ''{1}''"
(name old-strategy) (name new-strategy)))
(re-humanize-table-and-field-names! old-strategy)))) | |
(defsetting ^{:added "0.28.0"} humanization-strategy
(deferred-tru
(str "To make table and field names more human-friendly, Metabase will replace dashes and underscores in them "
"with spaces. We’ll capitalize each word while at it, so ‘last_visited_at’ will become ‘Last Visited At’."))
:type :keyword
:default :simple
:visibility :settings-manager
:export? true
:audit :raw-value
:getter (fn []
(let [strategy (setting/get-value-of-type :keyword :humanization-strategy)
valid-values (set (keys (methods u.humanization/name->human-readable-name)))
valid-strategy? (contains? valid-values strategy)]
(when (not valid-strategy?) (log/warn (u/format-color :yellow "Invalid humanization strategy '%s'. Defaulting to 'simple'" strategy)))
(if valid-strategy? strategy :simple)))
:setter set-humanization-strategy!) | |
(ns metabase.models.interface (:require [buddy.core.codecs :as codecs] [cheshire.core :as json] [cheshire.generate :as json.generate] [clojure.core.memoize :as memoize] [clojure.spec.alpha :as s] [clojure.walk :as walk] [malli.core :as mc] [malli.error :as me] [metabase.db.connection :as mdb.connection] [metabase.mbql.normalize :as mbql.normalize] [metabase.mbql.schema :as mbql.s] [metabase.models.dispatch :as models.dispatch] [metabase.models.json-migration :as jm] [metabase.plugins.classloader :as classloader] [metabase.util :as u] [metabase.util.cron :as u.cron] [metabase.util.encryption :as encryption] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log] [metabase.util.malli.registry :as mr] [methodical.core :as methodical] [potemkin :as p] [taoensso.nippy :as nippy] [toucan2.core :as t2] [toucan2.model :as t2.model] [toucan2.protocols :as t2.protocols] [toucan2.tools.before-insert :as t2.before-insert] [toucan2.tools.hydrate :as t2.hydrate] [toucan2.tools.identity-query :as t2.identity-query] [toucan2.util :as t2.u]) (:import (java.io BufferedInputStream ByteArrayInputStream DataInputStream) (java.sql Blob) (java.util.zip GZIPInputStream) (toucan2.instance Instance))) | |
(set! *warn-on-reflection* true) | |
#_{:clj-kondo/ignore [:deprecated-var]}
(p/import-vars
[models.dispatch
toucan-instance?
InstanceOf
InstanceOf:Schema
instance-of?
model
instance]) | |
This is dynamically bound to true when deserializing. A few pieces of the Toucan magic are undesirable for
deserialization. Most notably, we don't want to generate an | (def ^:dynamic *deserializing?* false) |
+----------------------------------------------------------------------------------------------------------------+ | Toucan Extensions | +----------------------------------------------------------------------------------------------------------------+ | |
[[define-simple-hydration-method]] and [[define-batched-hydration-method]] | |
(s/def ::define-hydration-method
(s/cat :fn-name symbol?
:hydration-key keyword?
:docstring string?
:fn-tail (s/alt :arity-1 :clojure.core.specs.alpha/params+body
:arity-n (s/+ (s/spec :clojure.core.specs.alpha/params+body))))) | |
(defonce ^:private defined-hydration-methods
(atom {})) | |
(defn- define-hydration-method [hydration-type fn-name hydration-key fn-tail]
{:pre [(#{:hydrate :batched-hydrate} hydration-type)]}
;; Let's be EXTRA nice and make sure there are no duplicate hydration keys!
(let [fn-symb (symbol (str (ns-name *ns*)) (name fn-name))]
(when-let [existing-fn-symb (get @defined-hydration-methods hydration-key)]
(when (not= fn-symb existing-fn-symb)
(throw (ex-info (format "Hydration key %s already exists at %s" hydration-key existing-fn-symb)
{:hydration-key hydration-key
:existing-definition existing-fn-symb}))))
(swap! defined-hydration-methods assoc hydration-key fn-symb))
`(do
(defn ~fn-name
~@fn-tail)
~(case hydration-type
:hydrate
`(methodical/defmethod t2.hydrate/simple-hydrate
[:default ~hydration-key]
[~'_model k# row#]
(assoc row# k# (~fn-name row#)))
:batched-hydrate
`(methodical/defmethod t2.hydrate/batched-hydrate
[:default ~hydration-key]
[~'_model ~'_k rows#]
(~fn-name rows#))))) | |
Define a Toucan hydration function (Toucan 1) or method (Toucan 2) to do 'simple' hydration (this function is called
for each individual object that gets hydrated). This helper is in place to make the switch to Toucan 2 easier to
accomplish. Toucan 2 uses multimethods instead of regular functions with | (defmacro define-simple-hydration-method
{:style/indent :defn}
[fn-name hydration-key & fn-tail]
(define-hydration-method :hydrate fn-name hydration-key fn-tail)) |
(s/fdef define-simple-hydration-method :args ::define-hydration-method :ret any?) | |
Like [[define-simple-hydration-method]], but defines a Toucan 'batched' hydration function (Toucan 1) or method (Toucan 2). 'Batched' hydration means this function can be used to hydrate a sequence of objects in one call. See docstring for [[define-simple-hydration-method]] for more information as to why this macro exists. | (defmacro define-batched-hydration-method
{:style/indent :defn}
[fn-name hydration-key & fn-tail]
(define-hydration-method :batched-hydrate fn-name hydration-key fn-tail)) |
(s/fdef define-batched-hydration-method :args ::define-hydration-method :ret any?) | |
+----------------------------------------------------------------------------------------------------------------+ | Toucan 2 Extensions | +----------------------------------------------------------------------------------------------------------------+ --- transforms methods | |
Default in function for columns given a Toucan type | (defn json-in
[obj]
(if (string? obj)
obj
(json/generate-string obj))) |
(defn- json-out [s keywordize-keys?]
(if (string? s)
(try
(json/parse-string s keywordize-keys?)
(catch Throwable e
(log/error e "Error parsing JSON")
s))
s)) | |
Default out function for columns given a Toucan type | (defn json-out-with-keywordization [obj] (json-out obj true)) |
Out function for columns given a Toucan type | (defn json-out-without-keywordization [obj] (json-out obj false)) |
Transform for json. | (def transform-json
{:in json-in
:out json-out-with-keywordization}) |
| (defn- maybe-normalize [query]
(cond-> query
(seq query) mbql.normalize/normalize)) |
Wraps normalization fn | (defn catch-normalization-exceptions
[f]
(fn [query]
(try
(doall (f query))
(catch Throwable e
(log/error e (tru "Unable to normalize:") "\n"
(u/pprint-to-str 'red query))
nil)))) |
Normalize | (defn normalize-parameters-list
[parameters]
(or (mbql.normalize/normalize-fragment [:parameters] parameters)
[])) |
Transform for metabase-query. | (def transform-metabase-query
{:in (comp json-in maybe-normalize)
:out (comp (catch-normalization-exceptions maybe-normalize) json-out-with-keywordization)}) |
Transform for parameters list. | (def transform-parameters-list
{:in (comp json-in normalize-parameters-list)
:out (comp (catch-normalization-exceptions normalize-parameters-list) json-out-with-keywordization)}) |
Transform field refs | (def transform-field-ref
{:in json-in
:out (comp (catch-normalization-exceptions mbql.normalize/normalize-field-ref) json-out-with-keywordization)}) |
Transform the Card result metadata as it comes out of the DB. Convert columns to keywords where appropriate. | (defn- result-metadata-out
[metadata]
;; TODO -- can we make this whole thing a lazy seq?
(when-let [metadata (not-empty (json-out-with-keywordization metadata))]
(seq (map mbql.normalize/normalize-source-metadata metadata)))) |
Transform for card.result_metadata like columns. | (def transform-result-metadata
{:in json-in
:out result-metadata-out}) |
Transform for keywords. | (def transform-keyword
{:in u/qualified-name
:out keyword}) |
Transform for json-no-keywordization | (def transform-json-no-keywordization
{:in json-in
:out json-out-without-keywordization}) |
Serialize encrypted json. | (def encrypted-json-in (comp encryption/maybe-encrypt json-in)) |
Deserialize encrypted json. | (defn encrypted-json-out
[v]
(let [decrypted (encryption/maybe-decrypt v)]
(try
(json/parse-string decrypted true)
(catch Throwable e
(if (or (encryption/possibly-encrypted-string? decrypted)
(encryption/possibly-encrypted-bytes? decrypted))
(log/error e "Could not decrypt encrypted field! Have you forgot to set MB_ENCRYPTION_SECRET_KEY?")
(log/error e "Error parsing JSON")) ; same message as in `json-out`
v)))) |
cache the decryption/JSON parsing because it's somewhat slow (~500µs vs ~100µs on a fast computer) cache the decrypted JSON for one hour | (def ^:private cached-encrypted-json-out (memoize/ttl encrypted-json-out :ttl/threshold (* 60 60 1000))) |
Transform for encrypted json. | (def transform-encrypted-json
{:in encrypted-json-in
:out cached-encrypted-json-out}) |
Transform for encrypted text. | (def transform-encrypted-text
{:in encryption/maybe-encrypt
:out encryption/maybe-decrypt}) |
The frontend uses JSON-serialized versions of MBQL clauses as keys in | (defn normalize-visualization-settings
[viz-settings]
(letfn [(normalize-column-settings-key [k]
(some-> k u/qualified-name json/parse-string mbql.normalize/normalize json/generate-string))
(normalize-column-settings [column-settings]
(into {} (for [[k v] column-settings]
[(normalize-column-settings-key k) (walk/keywordize-keys v)])))
(mbql-field-clause? [form]
(and (vector? form)
(#{"field-id" "fk->" "datetime-field" "joined-field" "binning-strategy" "field"
"aggregation" "expression"}
(first form))))
(normalize-mbql-clauses [form]
(walk/postwalk
(fn [form]
(cond-> form
(mbql-field-clause? form) mbql.normalize/normalize))
form))]
(cond-> (walk/keywordize-keys (dissoc viz-settings "column_settings" "graph.metrics"))
(get viz-settings "column_settings") (assoc :column_settings (normalize-column-settings (get viz-settings "column_settings")))
true normalize-mbql-clauses
;; exclude graph.metrics from normalization as it may start with
;; the word "expression" but it is not MBQL (metabase#15882)
(get viz-settings "graph.metrics") (assoc :graph.metrics (get viz-settings "graph.metrics"))))) |
(jm/def-json-migration migrate-viz-settings*) | |
(def ^:private viz-settings-current-version 2) | |
(defmethod ^:private migrate-viz-settings* [1 2] [viz-settings _]
(let [{percent? :pie.show_legend_perecent ;; [sic]
legend? :pie.show_legend} viz-settings]
(if-let [new-value (cond
legend? "inside"
percent? "legend")]
(assoc viz-settings :pie.percent_visibility new-value)
viz-settings))) ;; if nothing was explicitly set don't default to "off", let the FE deal with it | |
if nothing was explicitly set don't default to "off", let the FE deal with it | |
(defn- migrate-viz-settings
[viz-settings]
(let [new-viz-settings (migrate-viz-settings* viz-settings viz-settings-current-version)]
(cond-> new-viz-settings
(not= new-viz-settings viz-settings) (jm/update-version viz-settings-current-version)))) | |
migrate-viz settings was introduced with v. 2, so we'll never be in a situation where we can downgrade from 2 to 1. See sample code in SHA d597b445333f681ddd7e52b2e30a431668d35da8 | |
Transform for viz-settings. | (def transform-visualization-settings
{:in (comp json-in migrate-viz-settings)
:out (comp migrate-viz-settings normalize-visualization-settings json-out-without-keywordization)}) |
(def ^{:arglists '([s])} ^:private validate-cron-string
(let [validator (mc/validator u.cron/CronScheduleString)]
(fn [s]
(when (validator s)
s)))) | |
Transform for encrypted json. | (def transform-cron-string
{:in validate-cron-string
:out identity}) |
(def ^:private MetricSegmentDefinition
[:map
[:filter {:optional true} [:maybe mbql.s/Filter]]
[:aggregation {:optional true} [:maybe [:sequential mbql.s/Aggregation]]]]) | |
(def ^:private ^{:arglists '([definition])} validate-metric-segment-definition
(let [explainer (mr/explainer MetricSegmentDefinition)]
(fn [definition]
(if-let [error (explainer definition)]
(let [humanized (me/humanize error)]
(throw (ex-info (tru "Invalid Metric or Segment: {0}" (pr-str humanized))
{:error error
:humanized humanized})))
definition)))) | |
| (defn- normalize-metric-segment-definition [definition]
(when (seq definition)
(u/prog1 (mbql.normalize/normalize-fragment [:query] definition)
(validate-metric-segment-definition <>)))) |
Transform for inner queries like those in Metric definitions. | (def transform-metric-segment-definition
{:in (comp json-in normalize-metric-segment-definition)
:out (comp (catch-normalization-exceptions normalize-metric-segment-definition) json-out-with-keywordization)}) |
(defn- blob->bytes [^Blob b] (.getBytes ^Blob b 0 (.length ^Blob b))) | |
(defn- maybe-blob->bytes [v]
(if (instance? Blob v)
(blob->bytes v)
v)) | |
Transform for secret value. | (def transform-secret-value
{:in (comp encryption/maybe-encrypt-bytes codecs/to-bytes)
:out (comp encryption/maybe-decrypt maybe-blob->bytes)}) |
Decompress | (defn decompress
[compressed-bytes]
(if (instance? Blob compressed-bytes)
(recur (blob->bytes compressed-bytes))
(with-open [bis (ByteArrayInputStream. compressed-bytes)
bif (BufferedInputStream. bis)
gz-in (GZIPInputStream. bif)
data-in (DataInputStream. gz-in)]
(nippy/thaw-from-in! data-in)))) |
Transform for compressed fields. | #_{:clj-kondo/ignore [:unused-public-var]}
(def transform-compressed
{:in identity
:out decompress}) |
--- predefined hooks | |
Return a HoneySQL form for a SQL function call to get current moment in time. Currently this is | (defn now [] (classloader/require 'metabase.driver.sql.query-processor) ((resolve 'metabase.driver.sql.query-processor/current-datetime-honeysql-form) (mdb.connection/db-type))) |
(defn- add-created-at-timestamp [obj & _]
(cond-> obj
(not (:created_at obj)) (assoc :created_at (now)))) | |
(defn- add-updated-at-timestamp [obj]
;; don't stomp on `:updated_at` if it's already explicitly specified.
(let [changes-already-include-updated-at? (if (t2/instance? obj)
(:updated_at (t2/changes obj))
(:updated_at obj))]
(cond-> obj
(not changes-already-include-updated-at?) (assoc :updated_at (now))))) | |
(t2/define-before-insert :hook/timestamped?
[instance]
(-> instance
add-updated-at-timestamp
add-created-at-timestamp)) | |
(t2/define-before-update :hook/timestamped?
[instance]
(-> instance
add-updated-at-timestamp)) | |
(t2/define-before-insert :hook/created-at-timestamped?
[instance]
(-> instance
add-created-at-timestamp)) | |
(t2/define-before-insert :hook/updated-at-timestamped?
[instance]
(-> instance
add-updated-at-timestamp)) | |
(t2/define-before-update :hook/updated-at-timestamped?
[instance]
(-> instance
add-updated-at-timestamp)) | |
(defn- add-entity-id [obj & _]
(if (or (contains? obj :entity_id)
*deserializing?*)
;; Don't generate a new entity_id if either: (a) there's already one set; or (b) we're deserializing.
;; Generating them at deserialization time can lead to duplicated entities if they're deserialized again.
obj
(assoc obj :entity_id (u/generate-nano-id)))) | |
(t2/define-before-insert :hook/entity-id
[instance]
(-> instance
add-entity-id)) | |
(methodical/prefer-method! #'t2.before-insert/before-insert :hook/timestamped? :hook/entity-id) | |
Returns the changes used for pre-update hooks. This is to match the input of pre-update for toucan1 methods --- helper fns | (defn pre-update-changes
[row]
(t2.protocols/with-current row (merge (t2.model/primary-key-values-map row)
(t2.protocols/changes row)))) |
Do [[toucan2.tools.after-select]] stuff for row map | (defn do-after-select
[modelable row-map]
{:pre [(map? row-map)]}
(let [model (t2/resolve-model modelable)]
(try
(t2/select-one model (t2.identity-query/identity-query [row-map]))
(catch Throwable e
(throw (ex-info (format "Error doing after-select for model %s: %s" model (ex-message e))
{:model model}
e)))))) |
+----------------------------------------------------------------------------------------------------------------+ | New Permissions Stuff | +----------------------------------------------------------------------------------------------------------------+ | |
Helper dispatch function for multimethods. Dispatches on the first arg, using [[models.dispatch/model]]. | (def ^{:arglists '([x & _args])} dispatch-on-model
t2.u/dispatch-on-first-arg) |
Return a set of permissions object paths that a user must have access to in order to access this object. This should be something like #{"/db/1/schema/public/table/20/"}
| (defmulti perms-objects-set
{:arglists '([instance read-or-write])}
dispatch-on-model) |
(defmethod perms-objects-set :default [_instance _read-or-write] nil) | |
Return whether [[metabase.api.common/current-user]] has read permissions for an object. You should typically use one of these implementations:
| (defmulti can-read?
{:arglists '([instance] [model pk])}
dispatch-on-model) |
Return whether [[metabase.api.common/current-user]] has write permissions for an object. You should typically use one of these implementations:
| (defmulti can-write?
{:arglists '([instance] [model pk])}
dispatch-on-model) |
#_{:clj-kondo/ignore [:unused-private-var]}
(define-simple-hydration-method ^:private hydrate-can-write
:can_write
"Hydration method for `:can_write`."
[instance]
(can-write? instance)) | |
NEW! Check whether or not current user is allowed to CREATE a new instance of Because this method was added YEARS after [[can-read?]] and [[can-write?]], most models do not have an implementation
for this method, and instead | (defmulti can-create?
{:added "0.32.0", :arglists '([model m])}
dispatch-on-model) |
(defmethod can-create? :default
[model _m]
(throw
(NoSuchMethodException.
(str (format "%s does not yet have an implementation for [[can-create?]]. " (name model))
"Please consider adding one. See dox for [[can-create?]] for more details.")))) | |
NEW! Check whether or not the current user is allowed to update an object and by updating properties to values in
the (toucan2.core/update! model id changes) This method is appropriate for powering | (defmulti can-update?
{:added "0.36.0", :arglists '([instance changes])}
dispatch-on-model) |
(defmethod can-update? :default
[instance _changes]
(throw
(NoSuchMethodException.
(str (format "%s does not yet have an implementation for `can-update?`. " (name (models.dispatch/model instance)))
"Please consider adding one. See dox for `can-update?` for more details.")))) | |
Is [[metabase.api.common/current-user]] is a superuser? Ignores args. Intended for use as an implementation of [[can-read?]] and/or [[can-write?]]. | (defn superuser? [& _] @(requiring-resolve 'metabase.api.common/*is-superuser?*)) |
(defn- current-user-permissions-set [] @@(requiring-resolve 'metabase.api.common/*current-user-permissions-set*)) | |
(defn- current-user-has-root-permissions? [] (contains? (current-user-permissions-set) "/")) | |
(defn- check-perms-with-fn
([fn-symb read-or-write a-model object-id]
(or (current-user-has-root-permissions?)
(check-perms-with-fn fn-symb read-or-write (t2/select-one a-model (first (t2/primary-keys a-model)) object-id))))
([fn-symb read-or-write object]
(and object
(check-perms-with-fn fn-symb (perms-objects-set object read-or-write))))
([fn-symb perms-set]
(let [f (requiring-resolve fn-symb)]
(assert f)
(u/prog1 (f (current-user-permissions-set) perms-set)
(log/tracef "Perms check: %s -> %s" (pr-str (list fn-symb (current-user-permissions-set) perms-set)) <>))))) | |
Implementation of [[can-read?]]/[[can-write?]] for the old permissions system. | (def ^{:arglists '([read-or-write model object-id] [read-or-write object] [perms-set])}
current-user-has-full-permissions?
(partial check-perms-with-fn 'metabase.models.permissions/set-has-full-permissions-for-set?)) |
Implementation of [[can-read?]]/[[can-write?]] for the old permissions system. | (def ^{:arglists '([read-or-write model object-id] [read-or-write object] [perms-set])}
current-user-has-partial-permissions?
(partial check-perms-with-fn 'metabase.models.permissions/set-has-partial-permissions-for-set?)) |
(defmethod can-read? ::read-policy.always-allow ([_instance] true) ([_model _pk] true)) | |
(defmethod can-write? ::write-policy.always-allow ([_instance] true) ([_model _pk] true)) | |
(defmethod can-read? ::read-policy.partial-perms-for-perms-set ([instance] (current-user-has-partial-permissions? :read instance)) ([model pk] (current-user-has-partial-permissions? :read model pk))) | |
(defmethod can-read? ::read-policy.full-perms-for-perms-set ([instance] (current-user-has-full-permissions? :read instance)) ([model pk] (current-user-has-full-permissions? :read model pk))) | |
(defmethod can-write? ::write-policy.partial-perms-for-perms-set ([instance] (current-user-has-partial-permissions? :write instance)) ([model pk] (current-user-has-partial-permissions? :write model pk))) | |
(defmethod can-write? ::write-policy.full-perms-for-perms-set ([instance] (current-user-has-full-permissions? :write instance)) ([model pk] (current-user-has-full-permissions? :write model pk))) | |
(defmethod can-read? ::read-policy.superuser ([_instance] (superuser?)) ([_model _pk] (superuser?))) | |
(defmethod can-write? ::write-policy.superuser ([_instance] (superuser?)) ([_model _pk] (superuser?))) | |
(defmethod can-create? ::create-policy.superuser [_model _m] (superuser?)) | |
[[to-json]] | |
Serialize an | (methodical/defmulti to-json
{:arglists '([instance json-generator])
:defmethod-arities #{2}
:dispatch-value-spec (some-fn keyword? symbol?)} ; dispatch value should be either keyword model name or symbol
t2.u/dispatch-on-first-arg) |
(methodical/defmethod to-json :default "Default method for encoding instances of a Toucan model to JSON." [instance json-generator] (json.generate/encode-map instance json-generator)) | |
(json.generate/add-encoder Instance #'to-json) | |
etc | |
Trigger errors when hydrate encounters a key that has no corresponding method defined. | (reset! t2.hydrate/global-error-on-unknown-key true) |
(methodical/defmethod t2.hydrate/fk-keys-for-automagic-hydration :default "In Metabase the FK key used for automagic hydration should use underscores (work around upstream Toucan 2 issue)." [_original-model dest-key _hydrated-key] [(u/->snake_case_en (keyword (str (name dest-key) "_id")))]) | |
(ns metabase.models.json-migration) | |
Set the updated version if the column-value has data. Doesn't do anything if it's empty since empty values are assumed to result in version-appropriate default behavior and don't need an explicit version key. | (defn update-version
[column-value desired-version]
(if (seq column-value)
(assoc column-value :version desired-version)
column-value)) |
Create a multi-method with the given name that will perform JSON migrations. Individual cases (with appropriate
logic!) must be defined by the user. The resulting multi-method accepts two arguments: the value of the column and
the desired version. Versioning is assumed to start at 1 and be stored in the JSON blob under the For example, imagine a User model with a JSON column called
| (defmacro def-json-migration
[name]
(let [name* name]
`(do
(defmulti ^:private ~name*
"Migrate the column value to the appropriate version."
{:arglists '([~'column-value ~'desired-version])}
(fn [~'column-value ~'desired-version]
(let [~'current-version (or (get ~'column-value :version) 1)]
(if (= ~'current-version ~'desired-version)
::identity
[~'current-version ~'desired-version]))))
(defmethod ^:private ~name* ::identity [~'column-value ~'_]
~'column-value)))) |
(ns metabase.models.login-history (:require [java-time.api :as t] [metabase.email.messages :as messages] [metabase.models.setting :refer [defsetting]] [metabase.server.request.util :as request.u] [metabase.util.date-2 :as u.date] [metabase.util.i18n :as i18n :refer [trs tru]] [metabase.util.log :as log] [methodical.core :as methodical] [toucan2.connection :as t2.conn] [toucan2.core :as t2] [toucan2.realize :as t2.realize])) | |
(set! *warn-on-reflection* true) | |
(defn- timezone-display-name [^java.time.ZoneId zone-id]
(when zone-id
(.getDisplayName zone-id
java.time.format.TextStyle/SHORT_STANDALONE
(i18n/user-locale)))) | |
Return human-friendly versions of the info in one or more LoginHistory instances. Powers the login history API endpoint and login on new device email. This can potentially take a few seconds to complete, if the request to geocode the API request hangs for one reason or another -- keep that in mind when using this. | (defn human-friendly-infos
[history-items]
(let [ip-addresses (map :ip_address history-items)
ip->info (request.u/geocode-ip-addresses ip-addresses)]
(for [history-item history-items
:let [{location-description :description, timezone :timezone} (get ip->info (:ip_address history-item))]]
(-> history-item
(assoc :location location-description
:timezone (timezone-display-name timezone))
(update :timestamp (fn [timestamp]
(if (and timestamp timezone)
(t/zoned-date-time (u.date/with-time-zone-same-instant timestamp timezone) timezone)
timestamp)))
(update :device_description request.u/describe-user-agent))))) |
Should we send users a notification email the first time they log in from a new device? (Default: true). This is currently only configurable via environment variable so users who gain access to an admin's credentials cannot disable this Setting and access their account without them knowing. | (defsetting send-email-on-first-login-from-new-device ;; no need to i18n -- this isn't user-facing :type :boolean :visibility :internal :setter :none :default true) |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase. | (def LoginHistory :model/LoginHistory) |
(methodical/defmethod t2/table-name :model/LoginHistory [_model] :login_history) | |
(doto :model/LoginHistory (derive :metabase/model)) | |
(t2/define-after-select :model/LoginHistory
[{session-id :session_id, :as login-history}]
;; session ID is sensitive, so it's better if we don't even return it. Replace it with a more generic `active` key.
(cond-> (t2.realize/realize login-history)
(contains? login-history :session_id) (assoc :active (boolean session-id))
true (dissoc :session_id))) | |
(defn- first-login-ever? [{user-id :user_id}]
(some-> (t2/select [LoginHistory :id] :user_id user-id {:limit 2})
count
(= 1))) | |
(defn- first-login-on-this-device? [{user-id :user_id, device-id :device_id}]
(some-> (t2/select [LoginHistory :id] :user_id user-id, :device_id device-id, {:limit 2})
count
(= 1))) | |
If set to send emails on first login from new devices, that is the case, and its not the users first login, send an email from a separate thread. | (defn- maybe-send-login-from-new-device-email
[login-history]
(when (and (send-email-on-first-login-from-new-device)
(first-login-on-this-device? login-history)
(not (first-login-ever? login-history)))
;; if there's an existing open connection (and there seems to be one, but I'm not 100% sure why) we can't try to use
;; it across threads since it can close at any moment! So unbind it so the future can get its own thread.
(binding [t2.conn/*current-connectable* nil]
(future
;; off thread for both IP lookup and email sending. Either one could block and slow down user login (#16169)
(try
(let [[info] (human-friendly-infos [login-history])]
(messages/send-login-from-new-device-email! info))
(catch Throwable e
(log/error e (trs "Error sending ''login from new device'' notification email")))))))) |
(t2/define-after-insert :model/LoginHistory [login-history] (maybe-send-login-from-new-device-email login-history) login-history) | |
(t2/define-before-update :model/LoginHistory [_login-history] (throw (RuntimeException. (tru "You can''t update a LoginHistory after it has been created.")))) | |
A Metric is a saved MBQL 'macro' expanding to a combination of | (ns metabase.models.metric (:require [clojure.set :as set] [medley.core :as m] [metabase.lib.core :as lib] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.jvm :as lib.metadata.jvm] [metabase.lib.metadata.protocols :as lib.metadata.protocols] [metabase.lib.query :as lib.query] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.id :as lib.schema.id] [metabase.mbql.util :as mbql.u] [metabase.models.audit-log :as audit-log] [metabase.models.interface :as mi] [metabase.models.revision :as revision] [metabase.models.serialization :as serdes] [metabase.models.table :as table] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [methodical.core :as methodical] [toucan2.core :as t2] [toucan2.tools.hydrate :as t2.hydrate])) |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase. | (def Metric :model/Metric) |
(methodical/defmethod t2/table-name :model/Metric [_model] :metric) | |
(doto :model/Metric (derive :metabase/model) (derive :hook/timestamped?) (derive :hook/entity-id) (derive ::mi/read-policy.full-perms-for-perms-set) (derive ::mi/write-policy.superuser) (derive ::mi/create-policy.superuser)) | |
(t2/deftransforms :model/Metric
{:definition mi/transform-metric-segment-definition}) | |
(t2/define-before-update :model/Metric
[{:keys [creator_id id], :as metric}]
(u/prog1 (t2/changes metric)
;; throw an Exception if someone tries to update creator_id
(when (contains? <> :creator_id)
(when (not= (:creator_id <>) (t2/select-one-fn :creator_id Metric :id id))
(throw (UnsupportedOperationException. (tru "You cannot update the creator_id of a Metric."))))))) | |
(t2/define-before-delete :model/Metric
[{:keys [id] :as _metric}]
(t2/delete! :model/Revision :model "Metric" :model_id id)) | |
(defmethod mi/perms-objects-set Metric
[metric read-or-write]
(let [table (or (:table metric)
(t2/select-one ['Table :db_id :schema :id] :id (u/the-id (:table_id metric))))]
(mi/perms-objects-set table read-or-write))) | |
(mu/defn ^:private definition-description :- [:maybe ::lib.schema.common/non-blank-string]
"Calculate a nice description of a Metric's definition."
[metadata-provider :- lib.metadata/MetadataProvider
{:keys [definition], table-id :table_id, :as _metric} :- (ms/InstanceOf :model/Metric)]
(when (seq definition)
(try
(let [database-id (u/the-id (lib.metadata.protocols/database metadata-provider))
definition (merge {:source-table table-id}
definition)
query (lib.query/query-from-legacy-inner-query metadata-provider database-id definition)]
(lib/describe-query query))
(catch Throwable e
(log/error e (tru "Error calculating Metric description: {0}" (ex-message e)))
nil)))) | |
(mu/defn ^:private warmed-metadata-provider :- lib.metadata/MetadataProvider
[database-id :- ::lib.schema.id/database
metrics :- [:maybe [:sequential (ms/InstanceOf :model/Metric)]]]
(let [metadata-provider (doto (lib.metadata.jvm/application-database-metadata-provider database-id)
(lib.metadata.protocols/store-metadatas!
:metadata/metric
(map #(lib.metadata.jvm/instance->metadata % :metadata/metric)
metrics)))
segment-ids (into #{} (mbql.u/match (map :definition metrics)
[:segment (id :guard integer?) & _]
id))
segments (lib.metadata.protocols/bulk-metadata metadata-provider :metadata/segment segment-ids)
field-ids (mbql.u/referenced-field-ids (into []
(comp cat (map :definition))
[metrics segments]))
fields (lib.metadata.protocols/bulk-metadata metadata-provider :metadata/column field-ids)
table-ids (into #{}
cat
[(map :table-id fields)
(map :table-id segments)
(map :table_id metrics)])]
;; this is done for side-effects
(lib.metadata.protocols/bulk-metadata metadata-provider :metadata/table table-ids)
metadata-provider)) | |
(mu/defn ^:private metrics->table-id->warmed-metadata-provider :- fn?
[metrics :- [:maybe [:sequential (ms/InstanceOf :model/Metric)]]]
(let [table-id->db-id (when-let [table-ids (not-empty (into #{} (map :table_id metrics)))]
(t2/select-pk->fn :db_id :model/Table :id [:in table-ids]))
db-id->metadata-provider (memoize
(mu/fn db-id->warmed-metadata-provider :- lib.metadata/MetadataProvider
[database-id :- ::lib.schema.id/database]
(let [metrics-for-db (filter (fn [metric]
(= (table-id->db-id (:table_id metric))
database-id))
metrics)]
(warmed-metadata-provider database-id metrics-for-db))))]
(mu/fn table-id->warmed-metadata-provider :- lib.metadata/MetadataProvider
[table-id :- ::lib.schema.id/table]
(-> table-id table-id->db-id db-id->metadata-provider)))) | |
(methodical/defmethod t2.hydrate/batched-hydrate [Metric :definition_description]
[_model _key metrics]
(let [table-id->warmed-metadata-provider (metrics->table-id->warmed-metadata-provider metrics)]
(for [metric metrics
:let [metadata-provider (table-id->warmed-metadata-provider (:table_id metric))]]
(assoc metric :definition_description (definition-description metadata-provider metric))))) | |
--------------------------------------------------- REVISIONS ---------------------------------------------------- | |
(defmethod revision/serialize-instance Metric [_model _id instance] (dissoc instance :created_at :updated_at)) | |
(defmethod revision/diff-map Metric
[model metric1 metric2]
(if-not metric1
;; model is the first version of the metric
(m/map-vals (fn [v] {:after v}) (select-keys metric2 [:name :description :definition]))
;; do our diff logic
(let [base-diff ((get-method revision/diff-map :default)
model
(select-keys metric1 [:name :description :definition])
(select-keys metric2 [:name :description :definition]))]
(cond-> (merge-with merge
(m/map-vals (fn [v] {:after v}) (:after base-diff))
(m/map-vals (fn [v] {:before v}) (:before base-diff)))
(or (get-in base-diff [:after :definition])
(get-in base-diff [:before :definition])) (assoc :definition {:before (get metric1 :definition)
:after (get metric2 :definition)}))))) | |
------------------------------------------------- SERIALIZATION -------------------------------------------------- | |
(defmethod serdes/hash-fields Metric [_metric] [:name (serdes/hydrated-hash :table) :created_at]) | |
(defmethod serdes/extract-one "Metric"
[_model-name _opts metric]
(-> (serdes/extract-one-basics "Metric" metric)
(update :table_id serdes/*export-table-fk*)
(update :creator_id serdes/*export-user*)
(update :definition serdes/export-mbql))) | |
(defmethod serdes/load-xform "Metric" [metric]
(-> metric
serdes/load-xform-basics
(update :table_id serdes/*import-table-fk*)
(update :creator_id serdes/*import-user*)
(update :definition serdes/import-mbql))) | |
(defmethod serdes/dependencies "Metric" [{:keys [definition table_id]}]
(into [] (set/union #{(serdes/table->path table_id)}
(serdes/mbql-deps definition)))) | |
(defmethod serdes/storage-path "Metric" [metric _ctx]
(let [{:keys [id label]} (-> metric serdes/path last)]
(-> metric
:table_id
serdes/table->path
serdes/storage-table-path-prefix
(concat ["metrics" (serdes/storage-leaf-file-name id label)])))) | |
------------------------------------------------ Audit Log -------------------------------------------------------- | |
(defmethod audit-log/model-details :model/Metric
[metric _event-type]
(let [table-id (:table_id metric)
db-id (table/table-id->database-id table-id)]
(assoc
(select-keys metric [:name :description :revision_message])
:table_id table-id
:database_id db-id))) | |
Intersection table for | (ns metabase.models.metric-important-field (:require [metabase.models.interface :as mi] [methodical.core :as methodical] [toucan2.core :as t2])) |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase. | (def MetricImportantField :model/MetricImportantField) |
(methodical/defmethod t2/table-name :model/MetricImportantField [_model] :metric_important_field) | |
(doto :model/MetricImportantField (derive :metabase/model) (derive ::mi/read-policy.always-allow) (derive ::mi/write-policy.superuser)) | |
(t2/deftransforms :model/MetricImportantField
{:definition mi/transform-json}) | |
(ns metabase.models.model-index (:require [clojure.set :as set] [clojure.string :as str] [metabase.mbql.normalize :as mbql.normalize] [metabase.mbql.schema :as mbql.s] [metabase.models.card :refer [Card]] [metabase.models.interface :as mi] [metabase.query-processor :as qp] [metabase.sync.schedules :as sync.schedules] [metabase.util.cron :as u.cron] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [metabase.util.malli :as mu] [methodical.core :as methodical] [toucan2.core :as t2])) | |
model lifecycle ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all the ModelIndex symbol in our codebase. | (def ModelIndex :model/ModelIndex) |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all the ModelIndexValue symbol in our codebase. | (def ModelIndexValue :model/ModelIndexValue) |
(methodical/defmethod t2/table-name :model/ModelIndex [_model] :model_index) (methodical/defmethod t2/table-name :model/ModelIndexValue [_model] :model_index_value) (derive :model/ModelIndex :metabase/model) (derive :model/ModelIndexValue :metabase/model) | |
(derive :model/ModelIndex :hook/created-at-timestamped?) | |
(t2/deftransforms ModelIndex
{:pk_ref mi/transform-field-ref
:value_ref mi/transform-field-ref}) | |
(t2/define-before-delete ModelIndex
[model-index]
(let [remove-refresh-job (requiring-resolve 'metabase.task.index-values/remove-indexing-job)]
(remove-refresh-job model-index))) | |
Maximum number of values we will index. Actually take one more than this to test if there are more than the threshold. | (def max-indexed-values 5000) |
indexing functions | |
Filter function for valid tuples for indexing: an id and a value. | (defn valid-tuples? [[id v]] (and id v)) |
(mu/defn ^:private fix-expression-refs :- mbql.s/Field
"Convert expression ref into a field ref.
Expression refs (`[:expression \"full-name\"]`) are how the _query_ refers to a custom column. But nested queries
don't, (and shouldn't) care that those are expressions. They are just another field. The field type is always
`:type/Text` enforced by the endpoint to create model indexes."
[field-ref :- mbql.s/Field]
(case (first field-ref)
:field field-ref
:expression (let [[_ expression-name] field-ref]
;; api validated that this is a text field when the model-index was created. When selecting the
;; expression we treat it as a field.
[:field expression-name {:base-type :type/Text}])
(throw (ex-info (trs "Invalid field ref for indexing: {0}" field-ref)
{:field-ref field-ref
:valid-clauses [:field :expression]})))) | |
(defn- fetch-values
[model-index]
(let [model (t2/select-one Card :id (:model_id model-index))
value-ref (-> model-index
:value_ref
mbql.normalize/normalize-field-ref
fix-expression-refs)]
(try [nil (->> (qp/process-query
{:database (:database_id model)
:type :query
:query {:source-table (format "card__%d" (:id model))
:breakout [(:pk_ref model-index) value-ref]
:limit (inc max-indexed-values)}})
:data :rows (filter valid-tuples?))]
(catch Exception e
(log/warn (trs "Error fetching indexed values for model {0}" (:id model)) e)
[(ex-message e) []])))) | |
Find additions and deletions in indexed values. We have to identity values no longer in the set, values that must be added to the index, and primary keys which now have a different value. Updates will come out as a deletion and an addition. In the future we could make these an update if desired. | (defn find-changes
[{:keys [current-index source-values]}]
(let [current (set current-index)
;; into {} to ensure that each id appears only once. Later values "win".
source (set (into {} source-values))]
{:additions (set/difference source current)
:deletions (set/difference current source)})) |
Add indexed values to the modelindexvalue table. | (defn add-values!
[model-index]
(let [[error-message values-to-index] (fetch-values model-index)
current-index-values (into #{}
(map (juxt :model_pk :name))
(t2/select ModelIndexValue
:model_index_id (:id model-index)))]
(if-not (str/blank? error-message)
(t2/update! ModelIndex (:id model-index) {:state "error"
:error error-message
:indexed_at :%now})
(try
(t2/with-transaction [_conn]
(let [{:keys [additions deletions]} (find-changes {:current-index current-index-values
:source-values values-to-index})]
(when (seq deletions)
(t2/delete! ModelIndexValue
:model_index_id (:id model-index)
:pk_ref [:in (->> deletions (map first))]))
(when (seq additions)
(t2/insert! ModelIndexValue
(map (fn [[id v]]
{:name v
:model_pk id
:model_index_id (:id model-index)})
additions))))
(t2/update! ModelIndex (:id model-index)
{:indexed_at :%now
:state (if (> (count values-to-index) max-indexed-values)
"overflow"
"indexed")}))
(catch Exception e
(t2/update! ModelIndex (:id model-index)
{:state "error"
:error (ex-message e)
:indexed_at :%now})))))) |
creation | |
Default sync schedule for indexed values. Defaults to randomly once a day. | (defn default-schedule [] (u.cron/schedule-map->cron-string (sync.schedules/randomly-once-a-day))) |
Create a model index | (defn create
[{:keys [model-id pk-ref value-ref creator-id]}]
(first (t2/insert-returning-instances! ModelIndex
[{:model_id model-id
;; todo: sanitize these?
:pk_ref pk-ref
:value_ref value-ref
:schedule (default-schedule)
:state "initial"
:creator_id creator-id}]))) |
TODO -- this should be moved to | (ns metabase.models.moderation-review (:require [metabase.db.query :as mdb.query] [metabase.models.interface :as mi] [metabase.models.permissions :as perms] [metabase.moderation :as moderation] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [methodical.core :as methodical] [schema.core :as s] [toucan2.core :as t2])) |
Schema enum of the acceptable values for the | (def statuses
#{"verified" nil}) |
Schema of valid statuses | (def Statuses [:maybe (into [:enum] statuses)]) |
Schema for a ModerationReview that's being updated (so most keys are optional) currently unused, but I'm leaving this in commented out because it serves as documentation | (comment
(def ReviewChanges
{(s/optional-key :id) mu/IntGreaterThanZero
(s/optional-key :moderated_item_id) mu/IntGreaterThanZero
(s/optional-key :moderated_item_type) moderation/moderated-item-types
(s/optional-key :status) Statuses
(s/optional-key :text) [:maybe :string]
s/Any :any})) |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase. | (def ModerationReview :model/ModerationReview) |
(methodical/defmethod t2/table-name :model/ModerationReview [_model] :moderation_review) | |
(doto :model/ModerationReview (derive :metabase/model) ;;; TODO: this is wrong, but what should it be? (derive ::perms/use-parent-collection-perms) (derive :hook/timestamped?)) | |
(t2/deftransforms :model/ModerationReview
{:moderated_item_type mi/transform-keyword}) | |
The amount of moderation reviews we will keep on hand. | (def max-moderation-reviews 10) |
Delete extra reviews to maintain an invariant of only | (s/defn delete-extra-reviews!
[item-id :- s/Int item-type :- s/Str]
(let [ids (into #{} (comp (map :id)
(drop (dec max-moderation-reviews)))
(mdb.query/query {:select [:id]
:from [:moderation_review]
:where [:and
[:= :moderated_item_id item-id]
[:= :moderated_item_type item-type]]
;; cannot put the offset in this query as mysql doesnt place nice. It requires a limit
;; as well which we do not want to give. The offset is only 10 though so its not a huge
;; savings and we run this on every entry so the max number is 10, delete the extra,
;; and insert a new one to arrive at 10 again, our invariant.
:order-by [[:id :desc]]}))]
(when (seq ids)
(t2/delete! ModerationReview :id [:in ids])))) |
Create a new ModerationReview | (mu/defn create-review!
[params :-
[:map
[:moderated_item_id ms/PositiveInt]
[:moderated_item_type moderation/moderated-item-types]
[:moderator_id ms/PositiveInt]
[:status {:optional true} Statuses]
[:text {:optional true} [:maybe :string]]]]
(t2/with-transaction [_conn]
(delete-extra-reviews! (:moderated_item_id params) (:moderated_item_type params))
(t2/update! ModerationReview {:moderated_item_id (:moderated_item_id params)
:moderated_item_type (:moderated_item_type params)}
{:most_recent false})
(first (t2/insert-returning-instances! ModerationReview (assoc params :most_recent true))))) |
(ns metabase.models.native-query-snippet (:require [medley.core :as m] [metabase.models.collection :as collection] [metabase.models.interface :as mi] [metabase.models.native-query-snippet.permissions :as snippet.perms] [metabase.models.serialization :as serdes] [metabase.util :as u] [metabase.util.i18n :refer [deferred-tru tru]] [metabase.util.malli :as mu] [methodical.core :as methodical] [toucan2.core :as t2])) | |
----------------------------------------------- Entity & Lifecycle ----------------------------------------------- | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase. | (def NativeQuerySnippet :model/NativeQuerySnippet) |
(methodical/defmethod t2/table-name :model/NativeQuerySnippet [_model] :native_query_snippet) | |
(doto :model/NativeQuerySnippet (derive :metabase/model) (derive :hook/timestamped?) (derive :hook/entity-id)) | |
(defmethod collection/allowed-namespaces :model/NativeQuerySnippet
[_]
#{:snippets}) | |
(t2/define-before-insert :model/NativeQuerySnippet [snippet]
(u/prog1 snippet
(collection/check-collection-namespace NativeQuerySnippet (:collection_id snippet)))) | |
(t2/define-before-update :model/NativeQuerySnippet
[{:keys [creator_id id], :as snippet}]
(u/prog1 (t2/changes snippet)
;; throw an Exception if someone tries to update creator_id
(when (contains? <> :creator_id)
(when (not= (:creator_id <>) (t2/select-one-fn :creator_id NativeQuerySnippet :id id))
(throw (UnsupportedOperationException. (tru "You cannot update the creator_id of a NativeQuerySnippet.")))))
(collection/check-collection-namespace NativeQuerySnippet (:collection_id snippet)))) | |
(defmethod serdes/hash-fields NativeQuerySnippet [_snippet] [:name (serdes/hydrated-hash :collection) :created_at]) | |
(defmethod mi/can-read? NativeQuerySnippet [& args] (apply snippet.perms/can-read? args)) | |
(defmethod mi/can-write? NativeQuerySnippet [& args] (apply snippet.perms/can-write? args)) | |
(defmethod mi/can-create? NativeQuerySnippet [& args] (apply snippet.perms/can-create? args)) | |
(defmethod mi/can-update? NativeQuerySnippet [& args] (apply snippet.perms/can-update? args)) | |
---------------------------------------------------- Schemas ----------------------------------------------------- | |
Schema checking that snippet names do not include "}" or start with spaces. | (def NativeQuerySnippetName
(mu/with-api-error-message
[:fn (fn [x]
((every-pred
string?
(complement #(boolean (re-find #"^\s+" %)))
(complement #(boolean (re-find #"}" %))))
x))]
(deferred-tru "snippet names cannot include '}' or start with spaces"))) |
------------------------------------------------- Serialization -------------------------------------------------- | |
(defmethod serdes/extract-query "NativeQuerySnippet" [_ opts] (serdes/extract-query-collections NativeQuerySnippet opts)) | |
(defmethod serdes/extract-one "NativeQuerySnippet"
[_model-name _opts snippet]
(-> (serdes/extract-one-basics "NativeQuerySnippet" snippet)
(update :creator_id serdes/*export-user*)
(m/update-existing :collection_id #(serdes/*export-fk* % 'Collection)))) | |
(defmethod serdes/load-xform "NativeQuerySnippet" [snippet]
(-> snippet
serdes/load-xform-basics
(update :creator_id serdes/*import-user*)
(m/update-existing :collection_id #(serdes/*import-fk* % 'Collection)))) | |
(defmethod serdes/dependencies "NativeQuerySnippet"
[{:keys [collection_id]}]
(if collection_id
[[{:model "Collection" :id collection_id}]]
[])) | |
(defmethod serdes/storage-path "NativeQuerySnippet" [snippet ctx]
;; Intended path here is ["snippets" "<nested ... collections>" "<snippet_eid_and_slug>"]
;; We just the default path, then pull it apart.
;; The default is ["collections" "<nested ... collections>" "nativequerysnippets" "<base_name>"]
(let [basis (serdes/storage-default-collection-path snippet ctx)
file (last basis)
colls (->> basis rest (drop-last 2))] ; Drops the "collections" at the start, and the last two.
(concat ["snippets"] colls [file]))) | |
(defmethod serdes/load-one! "NativeQuerySnippet" [ingested maybe-local]
;; if we got local snippet in db and it has same name as incoming one, we can be sure
;; there will be no conflicts and skip the query to the db
(if (and (not= (:name ingested) (:name maybe-local))
(t2/exists? :model/NativeQuerySnippet
:name (:name ingested) :entity_id [:!= (:entity_id ingested)]))
(recur (update ingested :name str " (copy)")
maybe-local)
(serdes/default-load-one! ingested maybe-local))) | |
NativeQuerySnippets have different permissions implementations. In Metabase CE, anyone can read/edit/create all NativeQuerySnippets if they have native query perms for at least one database. EE has a more advanced implementation. | (ns metabase.models.native-query-snippet.permissions (:require [metabase.api.common :as api] [metabase.models.permissions :as perms] [metabase.public-settings.premium-features :refer [defenterprise]])) |
Checks whether the current user has native query permissions for any database. | (defn has-any-native-permissions? [] (perms/set-has-any-native-query-permissions? @api/*current-user-permissions-set*)) |
Can the current User read this | (defenterprise can-read? metabase-enterprise.snippet-collections.models.native-query-snippet.permissions ([_] (has-any-native-permissions?)) ([_ _] (has-any-native-permissions?))) |
Can the current User edit this | (defenterprise can-write? metabase-enterprise.snippet-collections.models.native-query-snippet.permissions ([_] (has-any-native-permissions?)) ([_ _] (has-any-native-permissions?))) |
Can the current User save a new Snippet with the values in | (defenterprise can-create? metabase-enterprise.snippet-collections.models.native-query-snippet.permissions [_ _] (has-any-native-permissions?)) |
Can the current User apply a map of | (defenterprise can-update? metabase-enterprise.snippet-collections.models.native-query-snippet.permissions [_ _] (has-any-native-permissions?)) |
(ns metabase.models.parameter-card (:require [metabase.models.interface :as mi] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [methodical.core :as methodical] [toucan2.core :as t2])) | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase. ----------------------------------------------- Entity & Lifecycle ----------------------------------------------- | (def ParameterCard :model/ParameterCard) |
(methodical/defmethod t2/table-name :model/ParameterCard [_model] :parameter_card) | |
(doto :model/ParameterCard (derive :metabase/model) (derive :hook/timestamped?)) | |
(t2/deftransforms :model/ParameterCard
{:parameterized_object_type mi/transform-keyword}) | |
Set of valid parameterizedobjecttype for a ParameterCard | (defonce
valid-parameterized-object-type #{"dashboard" "card"}) |
(defn- validate-parameterized-object-type
[{:keys [parameterized_object_type] :as _parameter-card}]
(when-not (valid-parameterized-object-type parameterized_object_type)
(throw (ex-info (tru "invalid parameterized_object_type")
{:allowed-types valid-parameterized-object-type})))) | |
(t2/define-before-insert :model/ParameterCard
[pc]
(u/prog1 pc
(validate-parameterized-object-type pc))) | |
(t2/define-before-update :model/ParameterCard
[pc]
(u/prog1 (t2/changes pc)
(when (:parameterized_object_type <>)
(validate-parameterized-object-type <>)))) | |
Delete all ParameterCard for a give Parameterized Object and NOT listed in the optional
| (defn delete-all-for-parameterized-object!
([parameterized-object-type parameterized-object-id]
(delete-all-for-parameterized-object! parameterized-object-type parameterized-object-id []))
([parameterized-object-type parameterized-object-id parameter-ids-still-in-use]
(let [conditions (concat [:parameterized_object_type parameterized-object-type
:parameterized_object_id parameterized-object-id]
(when (seq parameter-ids-still-in-use)
[:parameter_id [:not-in parameter-ids-still-in-use]]))]
(apply t2/delete! ParameterCard conditions)))) |
(defn- upsert-from-parameters!
[parameterized-object-type parameterized-object-id parameters]
(doseq [{:keys [values_source_config id]} parameters]
(let [card-id (:card_id values_source_config)
conditions {:parameterized_object_id parameterized-object-id
:parameterized_object_type parameterized-object-type
:parameter_id id}]
(or (pos? (t2/update! ParameterCard conditions {:card_id card-id}))
(t2/insert! ParameterCard (merge conditions {:card_id card-id})))))) | |
From a parameters list on card or dashboard, create, update, or delete appropriate ParameterCards for each parameter in the dashboard | (mu/defn upsert-or-delete-from-parameters!
[parameterized-object-type :- ms/NonBlankString
parameterized-object-id :- ms/PositiveInt
parameters :- [:maybe [:sequential ms/Parameter]]]
(let [upsertable? (fn [{:keys [values_source_type values_source_config id]}]
(and values_source_type id (:card_id values_source_config)
(= values_source_type "card")))
upsertable-parameters (filter upsertable? parameters)]
(upsert-from-parameters! parameterized-object-type parameterized-object-id upsertable-parameters)
(delete-all-for-parameterized-object! parameterized-object-type parameterized-object-id (map :id upsertable-parameters)))) |
Utility functions for dealing with parameters for Dashboards and Cards. Parameter are objects that exists on Dashboard/Card. In FE terms, we call it "Widget". The values of a parameter is provided so the Widget can show a list of options to the user. There are 3 mains ways to provide values to a parameter: - chain-filter: see [metabase.models.params.chain-filter] - field-values: see [metabase.models.params.field-values] - custom-values: see [metabase.models.params.custom-values] | (ns metabase.models.params (:require [clojure.set :as set] [malli.core :as mc] [medley.core :as m] [metabase.db.util :as mdb.u] [metabase.mbql.normalize :as mbql.normalize] [metabase.mbql.schema :as mbql.s] [metabase.mbql.util :as mbql.u] [metabase.models.field-values :as field-values] [metabase.models.interface :as mi] [metabase.models.params.field-values :as params.field-values] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
+----------------------------------------------------------------------------------------------------------------+ | SHARED | +----------------------------------------------------------------------------------------------------------------+ | |
Receive a Paremeterized Object and check if its parameters is valid. | (defn assert-valid-parameters
[{:keys [parameters]}]
(when-not (mc/validate [:maybe [:sequential ms/Parameter]] parameters)
(throw (ex-info (tru ":parameters must be a sequence of maps with :id and :type keys")
{:parameters parameters})))) |
Receive a Paremeterized Object and check if its parameters is valid. | (defn assert-valid-parameter-mappings
[{:keys [parameter_mappings]}]
(when-not (mc/validate [:maybe [:sequential ms/ParameterMapping]] parameter_mappings)
(throw (ex-info (tru ":parameter_mappings must be a sequence of maps with :parameter_id and :type keys")
{:parameter_mappings parameter_mappings})))) |
(mu/defn unwrap-field-clause :- [:maybe mbql.s/field]
"Unwrap something that contains a `:field` clause, such as a template tag.
Also handles unwrapped integers for legacy compatibility.
(unwrap-field-clause [:field 100 nil]) ; -> [:field 100 nil]"
[field-form]
(if (integer? field-form)
[:field field-form nil]
(mbql.u/match-one field-form :field))) | |
(mu/defn unwrap-field-or-expression-clause :- mbql.s/Field
"Unwrap a `:field` clause or expression clause, such as a template tag. Also handles unwrapped integers for
legacy compatibility."
[field-or-ref-form]
(or (unwrap-field-clause field-or-ref-form)
(mbql.u/match-one field-or-ref-form :expression))) | |
Wrap a raw Field ID in a | (defn wrap-field-id-if-needed
[field-id-or-form]
(cond
(mbql.u/mbql-clause? field-id-or-form)
field-id-or-form
(integer? field-id-or-form)
[:field field-id-or-form nil]
:else
field-id-or-form)) |
Whether to ignore permissions for the current User and return all FieldValues for the Fields being parameterized by
Cards and Dashboards. This determines how | (def ^:dynamic *ignore-current-user-perms-and-return-all-field-values* false) |
(defn- field-ids->param-field-values-ignoring-current-user
[param-field-ids]
(not-empty
(into {}
(map (comp (juxt :field_id identity)
#(select-keys % [:field_id :human_readable_values :values])
field-values/get-or-create-full-field-values!))
(t2/hydrate (t2/select :model/Field :id [:in (set param-field-ids)]) :values)))) | |
Given a collection of | (defn- field-ids->param-field-values
[param-field-ids]
(when (seq param-field-ids)
((if *ignore-current-user-perms-and-return-all-field-values*
field-ids->param-field-values-ignoring-current-user
params.field-values/field-id->field-values-for-current-user) param-field-ids))) |
Fetch the (template-tag->field-form [:template-tag :company] some-dashcard) ; -> [:field 100 nil] | (defn- template-tag->field-form [[_ tag] card] (get-in card [:dataset_query :native :template-tags (u/qualified-name tag) :dimension])) |
(mu/defn param-target->field-clause :- [:maybe mbql.s/Field]
"Parse a Card parameter `target` form, which looks something like `[:dimension [:field-id 100]]`, and return the Field
ID it references (if any)."
[target card]
(let [target (mbql.normalize/normalize target)]
(when (mbql.u/is-clause? :dimension target)
(let [[_ dimension] target
field-form (if (mbql.u/is-clause? :template-tag dimension)
(template-tag->field-form dimension card)
dimension)]
;; Being extra safe here since we've got many reports on this cause loading dashboard to fail
;; for unknown reasons. See #8917
(if field-form
(try
(unwrap-field-or-expression-clause field-form)
(catch Exception e
(log/error e "Failed unwrap field form" field-form)))
(log/error "Could not find matching field clause for target:" target)))))) | |
Return the | (defn- pk-fields [fields] (filter #(isa? (:semantic_type %) :type/PK) fields)) |
(def ^:private Field:params-columns-only
"Form for use in Toucan `t2/select` expressions (as a drop-in replacement for using `Field`) that returns Fields with
only the columns that are appropriate for returning in public/embedded API endpoints, which make heavy use of the
functions in this namespace. Use `conj` to add additional Fields beyond the ones already here. Use `rest` to get
just the column identifiers, perhaps for use with something like `select-keys`. Clutch!
(t2/select Field:params-columns-only)"
['Field :id :table_id :display_name :base_type :semantic_type :has_field_values]) | |
Given a sequence of | (defn- fields->table-id->name-field
[fields]
(when-let [table-ids (seq (map :table_id fields))]
(m/index-by :table_id (-> (t2/select Field:params-columns-only
:table_id [:in table-ids]
:semantic_type (mdb.u/isa :type/Name))
;; run [[metabase.lib.field/infer-has-field-values]] on these Fields so their values of
;; `has_field_values` will be consistent with what the FE expects. (e.g. we'll return
;; `:list` instead of `:auto-list`.)
(t2/hydrate :has_field_values))))) |
(mi/define-batched-hydration-method add-name-field
:name_field
"For all `fields` that are `:type/PK` Fields, look for a `:type/Name` Field belonging to the same Table. For each
Field, if a matching name Field exists, add it under the `:name_field` key. This is so the Fields can be used in
public/embedded field values search widgets. This only includes the information needed to power those widgets, and
no more."
[fields]
(let [table-id->name-field (fields->table-id->name-field (pk-fields fields))]
(for [field fields]
;; add matching `:name_field` if it's a PK
(assoc field :name_field (when (isa? (:semantic_type field) :type/PK)
(table-id->name-field (:table_id field))))))) | |
We hydrate the | |
Strip nonpublic columns from a | (defn- remove-dimension-nonpublic-columns
[dimension]
(some-> dimension
(update :human_readable_field #(select-keys % (rest Field:params-columns-only)))
;; these aren't exactly secret but you the frontend doesn't need them either so while we're at it let's go
;; ahead and strip them out
(dissoc :created_at :updated_at))) |
Strip nonpublic columns from the hydrated human-readable Field in the hydrated Dimensions in | (defn- remove-dimensions-nonpublic-columns
[fields]
(for [field fields]
(update field :dimensions (partial map remove-dimension-nonpublic-columns)))) |
Get the Fields (as a map of Field ID -> Field) that shoudl be returned for hydrated | (mu/defn ^:private param-field-ids->fields
[field-ids :- [:maybe [:set ms/PositiveInt]]]
(when (seq field-ids)
(m/index-by :id (-> (t2/select Field:params-columns-only :id [:in field-ids])
(t2/hydrate :has_field_values :name_field [:dimensions :human_readable_field])
remove-dimensions-nonpublic-columns)))) |
Add a | (defmulti ^:private ^{:hydrate :param_values} param-values
t2/model) |
#_{:clj-kondo/ignore [:unused-private-var]}
(mi/define-simple-hydration-method ^:private hydrate-param-values
:param_values
"Hydration method for `:param_fields`."
[instance]
(param-values instance)) | |
Add a | (defmulti ^:private ^{:hydrate :param_fields} param-fields
t2/model) |
#_{:clj-kondo/ignore [:unused-private-var]}
(mi/define-simple-hydration-method ^:private hydrate-param-fields
:param_fields
"Hydration method for `:param_fields`."
[instance]
(param-fields instance)) | |
+----------------------------------------------------------------------------------------------------------------+ | DASHBOARD-SPECIFIC | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn ^:private dashcards->parameter-mapping-field-clauses :- [:maybe [:set mbql.s/Field]]
"Return set of any Fields referenced directly by the Dashboard's `:parameters` (i.e., 'explicit' parameters) by
looking at the appropriate `:parameter_mappings` entries for its Dashcards."
[dashcards]
(when-let [fields (seq (for [dashcard dashcards
param (:parameter_mappings dashcard)
:let [field-clause (param-target->field-clause (:target param) (:card dashcard))]
:when field-clause]
field-clause))]
(set fields))) | |
(declare card->template-tag-field-ids) | |
Return the IDs of any Fields referenced in the 'implicit' template tag field filter parameters for native queries in
| (defn- cards->card-param-field-ids
[cards]
(reduce set/union #{} (map card->template-tag-field-ids cards))) |
(mu/defn dashcards->param-field-ids :- [:set ms/PositiveInt]
"Return a set of Field IDs referenced by parameters in Cards in the given `dashcards`, or `nil` if none are referenced. This
also includes IDs of Fields that are to be found in the 'implicit' parameters for SQL template tag Field filters.
`dashcards` must be hydrated with :card."
[dashcards]
(set/union
(set (mbql.u/match (seq (dashcards->parameter-mapping-field-clauses dashcards))
[:field (id :guard integer?) _]
id))
(cards->card-param-field-ids (map :card dashcards)))) | |
Retrieve a map relating paramater ids to field ids. | (defn get-linked-field-ids
[dashcards]
(letfn [(targets [params card]
(into {}
(for [param params
:let [clause (param-target->field-clause (:target param)
card)
ids (mbql.u/match clause
[:field (id :guard integer?) _]
id)]
:when (seq ids)]
[(:parameter_id param) (set ids)])))]
(->> dashcards
(mapv (fn [{params :parameter_mappings card :card}] (targets params card)))
(apply merge-with into {})))) |
Return a map of Field ID to FieldValues (if any) for any Fields referenced by Cards in | (defn- dashboard->param-field-values [dashboard] (field-ids->param-field-values (dashcards->param-field-ids (:dashcards dashboard)))) |
(defmethod param-values :model/Dashboard [dashboard] (dashboard->param-field-values dashboard)) | |
(defmethod param-fields :model/Dashboard [dashboard]
(-> (t2/hydrate dashboard [:dashcards :card])
:dashcards
dashcards->param-field-ids
param-field-ids->fields)) | |
+----------------------------------------------------------------------------------------------------------------+ | CARD-SPECIFIC | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn card->template-tag-field-clauses :- [:set mbql.s/field]
"Return a set of `:field` clauses referenced in template tag parameters in `card`."
[card]
(set (for [[_ {dimension :dimension}] (get-in card [:dataset_query :native :template-tags])
:when dimension
:let [field (unwrap-field-clause dimension)]
:when field]
field))) | |
(mu/defn card->template-tag-field-ids :- [:set ms/PositiveInt]
"Return a set of Field IDs referenced in template tag parameters in `card`. This is mostly used for determining
Fields referenced by Cards for purposes other than processing queries. Filters out `:field` clauses using names."
[card]
(set (mbql.u/match (seq (card->template-tag-field-clauses card))
[:field (id :guard integer?) _]
id)))
(defmethod param-values :model/Card [card]
(-> card card->template-tag-field-ids field-ids->param-field-values)) | |
(defmethod param-fields :model/Card [card] (-> card card->template-tag-field-ids param-field-ids->fields)) | |
Generate and run an MBQL query to return possible values of a given Field based on the values of other related Fields. RemappingThe main Field for which we search for values can optionally be remapped. ADDITIONAL CONSTRAINTS DO NOT SUPPORT REMAPPING! There are three types of remapping:
Here's some examples of what this namespace does. Suppose you do ;; find values of Field 1 starting with 'Cam' that are possible when Field 2 = "abc" (chain-filter-search 1 {2 "abc"} "Cam") Depending on the remapping situation, one of four things happens. A) Human-readable values remappingIf Field 1 has human-readable values, we find those values that contain the string 'Cam' and then generate a query to restrict results to the matching original values. e.g. if Field 1 is "venue.category_id" and is human-readable-remapped with something like {1 "Mexican", 2 "Camping Food", 3 "Campbell's Soup"} and you do the search above, then we generate a query that looks something like: SELECT category_id FROM venue WHERE id IN (2, 3) AND field_2 = "abc" (we then convert these values back to [value human-readable-value] pairs in Clojure-land) B) Field->Field remapping (either type)Suppose Field 1 is SELECT venue.category_id, category.name FROM venue LEFT JOIN category ON venue.category_id = category.id WHERE lower(category.name) LIKE 'cam%' AND field_2 = "abc" C) No remappingsLife is easy. Suppose Field 1 is SELECT name FROM category WHERE lower(name) LIKE '%cam' AND field_2 = "abc" | (ns metabase.models.params.chain-filter (:require [clojure.core.memoize :as memoize] [clojure.set :as set] [clojure.string :as str] [honey.sql :as sql] [metabase.db.connection :as mdb.connection] [metabase.db.query :as mdb.query] [metabase.db.util :as mdb.u] [metabase.driver.common.parameters.dates :as params.dates] [metabase.mbql.util :as mbql.u] [metabase.models :refer [Field FieldValues Table]] [metabase.models.field :as field] [metabase.models.field-values :as field-values] [metabase.models.params :as params] [metabase.models.params.chain-filter.dedupe-joins :as dedupe] [metabase.models.params.field-values :as params.field-values] [metabase.models.table :as table] [metabase.query-processor :as qp] [metabase.types :as types] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
so the hydration method for name_field is loaded | (comment params/keep-me) |
for [[memoize/ttl]] keys | (comment mdb.connection/keep-me) |
Schema for a constraint on a field. | (def Constraint
[:map
[:field-id ms/PositiveInt]
[:op :keyword]
[:value :any]
[:options {:optional true} [:maybe map?]]]) |
Schema for a list of Constraints. | (def Constraints [:sequential Constraint]) |
Whether to chain filter via joins where we must follow relationships in reverse, e.g. child -> parent (e.g. Restaurant -> Category instead of the usual Category -> Restuarant*) This switch mostly exists because I'm not 100% sure what the right behavior is. | (def ^:dynamic *enable-reverse-joins* true) |
(defn- joined-table-alias [table-id] (format "table_%d" table-id)) | |
Whether Field with | (def ^:private ^{:arglists '([field-id])} temporal-field?
(memoize/ttl
^{::memoize/args-fn (fn [[field-id]]
[(mdb.connection/unique-identifier) field-id])}
(fn [field-id]
(types/temporal-field? (t2/select-one [Field :base_type :semantic_type] :id field-id)))
:ttl/threshold (u/minutes->ms 10))) |
Generate a single MBQL | (mu/defn ^:private filter-clause
[source-table-id
{:keys [field-id op value options]} :- Constraint]
(let [field-clause (let [this-field-table-id (field/field-id->table-id field-id)]
[:field field-id (when-not (= this-field-table-id source-table-id)
{:join-alias (joined-table-alias this-field-table-id)})])]
(if (and (temporal-field? field-id)
(string? value))
(u/ignore-exceptions
(params.dates/date-string->filter value field-id))
(cond-> [op field-clause]
;; we don't want to skip our value, even if its nil
true (into (if value (u/one-or-many value) [nil]))
(seq options) (conj options))))) |
(defn- name-for-logging [model id] (format "%s %d %s" (name model) id (u/format-color 'blue (pr-str (t2/select-one-fn :name model :id id))))) | |
(defn- format-join-for-logging [join]
(format "%s %s -> %s %s"
(name-for-logging Table (-> join :lhs :table))
(name-for-logging Field (-> join :lhs :field))
(name-for-logging Table (-> join :rhs :table))
(name-for-logging Field (-> join :rhs :field)))) | |
(defn- format-joins-for-logging [joins]
(str/join "\n"
(map-indexed (fn [i join]
(format "%d. %s" (inc i) (format-join-for-logging join)))
joins))) | |
(defn- add-filters [query source-table-id joined-table-ids constraints]
(reduce
(fn [query {:keys [field-id] :as constraint}]
;; only add a where clause for the Field if it's part of the source Table or if we're actually joining against
;; the Table it belongs to. This Field might not even be part of the same Database in which case we can ignore
;; it.
(let [field-table-id (field/field-id->table-id field-id)]
(if (or (= field-table-id source-table-id)
(contains? joined-table-ids field-table-id))
(let [clause (filter-clause source-table-id constraint)]
(log/tracef "Added filter clause for %s %s: %s"
(name-for-logging Table field-table-id)
(name-for-logging Field field-id)
clause)
(update query :filter mbql.u/combine-filter-clauses clause))
(do
(log/tracef "Not adding filter clause for %s %s because we did not join against its Table"
(name-for-logging Table field-table-id)
(name-for-logging Field field-id))
query))))
query
constraints)) | |
Amount of time to cache results of | (def ^:private find-joins-cache-duration-ms ;; 5 minutes seems reasonable (u/minutes->ms 5)) |
(defn- database-fk-relationships* [database-id enable-reverse-joins?]
(let [rows (mdb.query/query {:select [[:fk-field.id :f1]
[:fk-table.id :t1]
[:pk-field.id :f2]
[:pk-field.table_id :t2]]
:from [[:metabase_field :fk-field]]
:left-join [[:metabase_table :fk-table] [:= :fk-field.table_id :fk-table.id]
[:metabase_database :database] [:= :fk-table.db_id :database.id]
[:metabase_field :pk-field] [:= :fk-field.fk_target_field_id :pk-field.id]]
:where [:and
[:= :database.id database-id]
[:not= :fk-field.fk_target_field_id nil]]})]
(reduce
(partial merge-with merge)
{}
(for [{:keys [t1 f1 t2 f2]} rows]
(merge
{t1 {t2 [{:lhs {:table t1, :field f1}, :rhs {:table t2, :field f2}}]}}
(let [reverse-join {:lhs {:table t2, :field f2}, :rhs {:table t1, :field f1}}]
(if enable-reverse-joins?
{t2 {t1 [reverse-join]}}
(log/tracef "Not including reverse join (disabled) %s" (format-join-for-logging reverse-join))))))))) | |
Return a sequence of FK relationships that exist in a database, in the format lhs-table-id -> rhs-table-id -> [join-info*] where {:lhs {:table 'lhs' refers to the Table and Field on the left-hand-side of the join, and 'rhs' refers to the Table on the
right-hand-side of the join. Of course, you can join in either direction (e.g. | (def ^:private ^{:arglists '([database-id enable-reverse-joins?])} database-fk-relationships
(memoize/ttl
^{::memoize/args-fn (fn [[database-id enable-reverse-joins?]]
[(mdb.connection/unique-identifier) database-id enable-reverse-joins?])}
database-fk-relationships*
:ttl/threshold find-joins-cache-duration-ms)) |
A breadth first traversal of graph, not probing any paths that are over | (defn- traverse-graph
[graph start end max-depth]
(letfn [(transform [path] (let [edges (partition 2 1 path)]
(not-empty (vec (mapcat (fn [[x y]] (get-in graph [x y])) edges)))))]
(loop [paths (conj clojure.lang.PersistentQueue/EMPTY [start])
seen #{start}]
(let [path (peek paths)
node (peek path)]
(cond (nil? node)
nil
;; found a path, bfs finds shortest first
(= node end)
(transform path)
;; abandon this path. A bit hazy on how seen and max depth interact.
(= (count path) max-depth)
(recur (pop paths) seen)
;; probe further and throw them on the queue
:else
(let [next-nodes (->> (get graph node)
keys
(remove seen))]
(recur (into (pop paths) (for [n next-nodes] (conj path n)))
(set/union seen (set next-nodes))))))))) |
(def ^:private max-traversal-depth 5) | |
(defn- find-joins* [database-id source-table-id other-table-id enable-reverse-joins?]
(let [fk-relationships (database-fk-relationships database-id enable-reverse-joins?)]
;; find series of joins needed to get from LHS -> RHS. `path` is the tables we're already joining against when
;; recursing so we don't end up coming up with circular joins.
;;
;; the general idea here is to see if LHS can join directly against RHS, otherwise recursively try all of the
;; tables LHS can join against and see if we can find a path that way.
(u/prog1 (traverse-graph fk-relationships source-table-id other-table-id max-traversal-depth)
(when (seq <>)
(log/tracef (format-joins-for-logging <>)))))) | |
Find the joins that must be done to make fields in Table with [{:lhs {:table e.g. ;; 'airport' is the source Table; find the joins needed to include 'country' Table
(find-joins my-database-id | (def ^:private ^{:arglists '([database-id source-table-id other-table-id]
[database-id source-table-id other-table-id enable-reverse-joins?])} find-joins
(let [f (memoize/ttl
^{::memoize/args-fn (fn [[database-id source-table-id other-table-id enable-reverse-joins?]]
[(mdb.connection/unique-identifier)
database-id
source-table-id
other-table-id
enable-reverse-joins?])}
find-joins*
:ttl/threshold find-joins-cache-duration-ms)]
(fn
([database-id source-table-id other-table-id]
(f database-id source-table-id other-table-id *enable-reverse-joins*))
([database-id source-table-id other-table-id enable-reverse-joins?]
(f database-id source-table-id other-table-id enable-reverse-joins?))))) |
(def ^:private ^{:arglists '([source-table other-table-ids enable-reverse-joins?])} find-all-joins*
(memoize/ttl
^{::memoize/args-fn (fn [[source-table-id other-table-ids enable-reverse-joins?]]
[(mdb.connection/unique-identifier) source-table-id other-table-ids enable-reverse-joins?])}
(fn [source-table-id other-table-ids enable-reverse-joins?]
(let [db-id (table/table-id->database-id source-table-id)
all-joins (mapcat #(find-joins db-id source-table-id % enable-reverse-joins?)
other-table-ids)]
(when (seq all-joins)
(log/tracef "Deduplicating for source %s; Tables to keep: %s\n%s"
(name-for-logging Table source-table-id)
(str/join ", " (map (partial name-for-logging Table)
other-table-ids))
(format-joins-for-logging all-joins))
(u/prog1 (vec (dedupe/dedupe-joins source-table-id all-joins other-table-ids))
(when-not (= all-joins <>)
(log/tracef "Deduplicated:\n%s" (format-joins-for-logging <>)))))))
:ttl/threshold find-joins-cache-duration-ms)) | |
Find the complete set of joins we need to do for | (defn- find-all-joins
[source-table-id field-ids]
(when-let [other-table-ids (not-empty (disj (set (map field/field-id->table-id (set field-ids)))
source-table-id))]
(find-all-joins* source-table-id other-table-ids *enable-reverse-joins*))) |
Add joins to the MBQL When we generate joins, we must determine the other Tables we must join against so that we have access to the other Fields. The relationship between these other Tables and the source Table may go in either direction, i.e. the source Table may have a FK to the other Table, or the other Table might have an FK to the source Table. e.g. the join condition may be either: sourcetable.fk = othertable.pk -- or sourcetable.pk = othertable.fk Since we're not sure which way the relationship goes, | (defn- add-joins
[query source-table-id joins]
(reduce
(fn [query {{lhs-table-id :table, lhs-field-id :field} :lhs, {rhs-table-id :table, rhs-field-id :field} :rhs}]
(let [join {:source-table rhs-table-id
:condition [:=
[:field lhs-field-id (when-not (= lhs-table-id source-table-id)
{:join-alias (joined-table-alias lhs-table-id)})]
[:field rhs-field-id {:join-alias (joined-table-alias rhs-table-id)}]]
:alias (joined-table-alias rhs-table-id)}]
(log/tracef "Adding join against %s\n%s"
(name-for-logging Table rhs-table-id) (u/pprint-to-str join))
(update query :joins concat [join])))
query
joins)) |
(def ^:private Options
;; if original-field-id is specified, we'll include this in the results. For Field->Field remapping.
[:map {:closed true}
[:original-field-id {:optional true} [:maybe ms/PositiveInt]]
;; return at most the lesser of `limit` (if specified) and `max-results`.
[:limit {:optional true} [:maybe ms/PositiveInt]]]) | |
(def ^:private max-results 1000) | |
Generate the MBQL query powering | (mu/defn ^:private chain-filter-mbql-query
[field-id :- ms/PositiveInt
constraints :- [:maybe Constraints]
{:keys [original-field-id limit]} :- [:maybe Options]]
{:database (field/field-id->database-id field-id)
:type :query
:query (let [source-table-id (field/field-id->table-id field-id)
joins (find-all-joins source-table-id (cond-> (set (map :field-id constraints))
original-field-id (conj original-field-id)))
joined-table-ids (set (map #(get-in % [:rhs :table]) joins))
original-field-clause (when original-field-id
(let [original-table-id (field/field-id->table-id original-field-id)]
[:field
original-field-id
(when-not (= source-table-id original-table-id)
{:join-alias (joined-table-alias original-table-id)})]))]
(when original-field-id
(log/tracef "Finding values of %s, remapped from %s."
(name-for-logging Field field-id)
(name-for-logging Field original-field-id))
(log/tracef "MBQL clause for %s is %s"
(name-for-logging Field original-field-id) (pr-str original-field-clause)))
(when (seq joins)
(log/tracef "Generating joins and filters for source %s with joins info\n%s"
(name-for-logging Table source-table-id) (pr-str joins)))
(-> (merge {:source-table source-table-id
;; original-field-id is used to power Field->Field breakouts. We include both remapped and
;; original
:breakout (if original-field-clause
[original-field-clause [:field field-id nil]]
[[:field field-id nil]])
;; return the lesser of limit (if set) or max results
:limit ((fnil min Integer/MAX_VALUE) limit max-results)}
(when original-field-clause
{ ;; don't return rows that don't have values for the original Field. e.g. if
;; venues.category_id is remapped to categories.name and we do a search with query 's',
;; we only want to return [category_id name] tuples where [category_id] is not nil
;;
;; TODO -- would this be more efficient if we just did an INNER JOIN against the original
;; Table instead of a LEFT JOIN with this additional filter clause? Would that still
;; work?
:filter [:not-null original-field-clause]
;; for Field->Field remapping we want to return pairs of [original-value remapped-value],
;; but sort by [remapped-value]
:order-by [[:asc [:field field-id nil]]]}))
(add-joins source-table-id joins)
(add-filters source-table-id joined-table-ids constraints)))
:middleware {:disable-remaps? true}}) |
------------------------ Chain filter (powers GET /api/dashboard/:id/params/:key/values) ------------------------- | |
(mu/defn ^:private unremapped-chain-filter :- ms/FieldValuesResult
"Chain filtering without all the fancy remapping stuff on top of it."
[field-id :- ms/PositiveInt
constraints :- [:maybe Constraints]
options :- [:maybe Options]]
(let [mbql-query (chain-filter-mbql-query field-id constraints options)]
(log/debugf "Chain filter MBQL query:\n%s" (u/pprint-to-str 'magenta mbql-query))
(try
(let [query-limit (get-in mbql-query [:query :limit])
values (qp/process-query mbql-query (constantly conj) nil)]
{:values values
;; It's unlikely that we don't have a query-limit, but better safe than sorry and default it true
;; so that calling chain-filter-search on the same field will search from DB.
:has_more_values (if (nil? query-limit)
true
(= (count values) query-limit))})
(catch Throwable e
(throw (ex-info (tru "Error executing chain filter query")
{:field-id field-id
:constraints constraints
:mbql-query mbql-query}
e)))))) | |
Schema for the map of actual value -> human-readable value. Cannot be empty. | (def ^:private HumanReadableRemappingMap
[:map-of {:min 1} :any [:maybe :string]]) |
(mu/defn ^:private human-readable-remapping-map :- [:maybe HumanReadableRemappingMap]
[field-id :- ms/PositiveInt]
(when-let [{orig :values, remapped :human_readable_values} (t2/select-one [FieldValues :values :human_readable_values]
{:where [:and
[:= :type "full"]
[:= :field_id field-id]
[:not= :human_readable_values nil]
[:not= :human_readable_values "{}"]]})]
(when (seq remapped)
(zipmap orig remapped)))) | |
Convert result | (mu/defn ^:private add-human-readable-values
[values :- [:sequential ms/NonRemappedFieldValue]
v->human-readable :- HumanReadableRemappingMap]
(map vector
(map first values)
(map (fn [[v]]
(get v->human-readable v (get v->human-readable (str v))))
values))) |
Workaround for https://github.com/seancorfield/honeysql/issues/451. Wrap the subselects in parens, otherwise it will fail on Postgres. | (defn- format-union
[_clause exprs]
(let [[sqls args] (sql/format-expr-list exprs)
sql (str/join " UNION " sqls)]
(into [sql] args))) |
(sql/register-clause! ::union format-union :union) | |
(defn- remapped-field-id-query [field-id]
{:select [[:ids.id :id]]
:from [[{::union [;; Explicit FK Field->Field remapping
{:select [[:dimension.human_readable_field_id :id]]
:from [[:dimension :dimension]]
:where [:and
[:= :dimension.field_id field-id]
[:not= :dimension.human_readable_field_id nil]]
:limit 1}
;; Implicit PK Field-> [Name] Field remapping
{:select [[:dest.id :id]]
:from [[:metabase_field :source]]
:left-join [[:metabase_table :table] [:= :source.table_id :table.id]
[:metabase_field :dest] [:= :dest.table_id :table.id]]
:where [:and
[:= :source.id field-id]
(mdb.u/isa :source.semantic_type :type/PK)
(mdb.u/isa :dest.semantic_type :type/Name)]
:limit 1}]}
:ids]]
:limit 1}) | |
TODO -- add some caching here? | (mu/defn remapped-field-id :- [:maybe ms/PositiveInt] "Efficient query to find the ID of the Field we're remapping `field-id` to, if it has either type of Field -> Field remapping." [field-id :- [:maybe ms/PositiveInt]] (:id (t2/query-one (remapped-field-id-query field-id)))) |
Whether we should use cached | (defn- use-cached-field-values?
[field-id]
(and
field-id
(field-values/field-should-have-field-values? field-id))) |
(defn- cached-field-values [field-id constraints {:keys [limit]}]
;; TODO: why don't we remap the human readable values here?
(let [{:keys [values has_more_values]}
(if (empty? constraints)
(params.field-values/get-or-create-field-values-for-current-user! (t2/select-one Field :id field-id))
(params.field-values/get-or-create-linked-filter-field-values! (t2/select-one Field :id field-id) constraints))]
{:values (cond->> values
limit (take limit))
:has_more_values (or (when limit
(< limit (count values)))
has_more_values)})) | |
(mu/defn chain-filter :- ms/FieldValuesResult
"Fetch a sequence of possible values of Field with `field-id` by restricting the possible values to rows that match
values of other Fields in the `constraints` map. Powers the `GET /api/dashboard/:id/param/:key/values` chain filter
API endpoint.
;; fetch possible values of venue price (between 1 and 4 inclusive) where category name is 'BBQ'
(chain-filter %venues.price {%categories.name \"BBQ\"})
;; -> {:values [1 2 3] (there are no BBQ places with price = 4)
:has_more_values false}
`options` are key-value options. Currently only one option is supported, `:limit`:
;; fetch first 10 values of venues.price
(chain-filter %venues.price {} :limit 10)
For remapped columns, this returns results as a sequence of `[value remapped-value]` pairs."
[field-id :- ms/PositiveInt
constraints :- [:maybe Constraints]
& options]
(assert (even? (count options)))
(let [{:as options} options
v->human-readable (human-readable-remapping-map field-id)
the-remapped-field-id (delay (remapped-field-id field-id))]
(cond
;; This is for fields that have human-readable values defined (e.g. you've went in and specified that enum
;; value `1` should be displayed as `BIRD_TYPE_TOUCAN`). `v->human-readable` is a map of actual values in the
;; database (e.g. `1`) to the human-readable version (`BIRD_TYPE_TOUCAN`).
(some? v->human-readable)
(-> (unremapped-chain-filter field-id constraints options)
(update :values add-human-readable-values v->human-readable))
(and (use-cached-field-values? field-id) (nil? @the-remapped-field-id))
(cached-field-values field-id constraints options)
;; This is Field->Field remapping e.g. `venue.category_id `-> `category.name `;
;; search by `category.name` but return tuples of `[venue.category_id category.name]`.
(some? @the-remapped-field-id)
(unremapped-chain-filter @the-remapped-field-id constraints (assoc options :original-field-id field-id))
:else
(unremapped-chain-filter field-id constraints options)))) | |
----------------- Chain filter search (powers GET /api/dashboard/:id/params/:key/search/:query) ----------------- | |
Before running a search query, make sure the Field actually exists and that it's a Text field. TODO -- if this validation succeeds, we can probably cache that success for a bit so we can avoid unneeded DB calls every time this function is called. | (defn- check-valid-search-field
[field-id]
(let [base-type (t2/select-one-fn :base_type Field :id field-id)]
(when-not base-type
(throw (ex-info (tru "Field {0} does not exist." field-id)
{:field field-id, :status-code 404})))
(when-not (isa? base-type :type/Text)
(let [field-name (t2/select-one-fn :name Field :id field-id)]
(throw (ex-info (tru "Cannot search against non-Text Field {0} {1}" field-id (pr-str field-name))
{:status-code 400
:field-id field-id
:field field-name
:base-type base-type})))))) |
(mu/defn ^:private unremapped-chain-filter-search
[field-id :- ms/PositiveInt
constraints :- [:maybe Constraints]
query :- ms/NonBlankString
options :- [:maybe Options]]
(check-valid-search-field field-id)
(let [constraints (conj constraints {:field-id field-id
:op :contains
:value query
:options {:case-sensitive false}})]
(unremapped-chain-filter field-id constraints options))) | |
(defn- matching-unremapped-values [query v->human-readable]
(let [query (u/lower-case-en query)]
(for [[orig remapped] v->human-readable
:when (and (string? remapped)
(str/includes? (u/lower-case-en remapped) query))]
orig))) | |
Chain filter search, but for Fields that have human-readable values defined (e.g. you've went in and specified that
enum value | (mu/defn ^:private human-readable-values-remapped-chain-filter-search
[field-id :- ms/PositiveInt
v->human-readable :- HumanReadableRemappingMap
constraints :- [:maybe Constraints]
query :- ms/NonBlankString
options :- [:maybe Options]]
(or (when-let [unremapped-values (not-empty (matching-unremapped-values query v->human-readable))]
(let [constraints (conj constraints {:field-id field-id
:op :=
:value (set unremapped-values)
:options nil})
result (unremapped-chain-filter field-id constraints options)]
(update result :values add-human-readable-values v->human-readable)))
{:values []
:has_more_values false})) |
(defn- search-cached-field-values? [field-id constraints]
(and (use-cached-field-values? field-id)
(isa? (t2/select-one-fn :base_type Field :id field-id) :type/Text)
(apply t2/exists? FieldValues (mapcat
identity
(merge {:field_id field-id, :values [:not= nil], :human_readable_values nil}
;; if we are doing a search, make sure we only use field values
;; when we're certain the fieldvalues we stored are all the possible values.
;; otherwise, we should search directly from DB
{:has_more_values false}
(if-not (empty? constraints)
{:type "linked-filter"
:hash_key (params.field-values/hash-key-for-advanced-field-values :linked-filter field-id constraints)}
(if-let [hash-key (params.field-values/hash-key-for-advanced-field-values :sandbox field-id nil)]
{:type "sandbox"
:hash_key hash-key}
{:type "full"}))))))) | |
(defn- cached-field-values-search
[field-id query constraints {:keys [limit]}]
(let [{:keys [values has_more_values]} (cached-field-values field-id constraints nil)
query (u/lower-case-en query)]
{:values (cond->> (filter (fn [s]
(when s
(str/includes? (u/lower-case-en s) query)))
values)
limit (take limit))
:has_more_values has_more_values})) | |
(mu/defn chain-filter-search :- ms/FieldValuesResult
"Convenience version of `chain-filter` that adds a constraint to only return values of Field with `field-id`
containing String `query`. Powers the `search/:query` version of the chain filter endpoint."
[field-id :- ms/PositiveInt
constraints :- [:maybe Constraints]
query :- [:maybe ms/NonBlankString]
& options]
(assert (even? (count options)))
(let [{:as options} options
v->human-readable (delay (human-readable-remapping-map field-id))
the-remapped-field-id (delay (remapped-field-id field-id))]
(cond
(str/blank? query)
(apply chain-filter field-id constraints options)
(some? @v->human-readable)
(human-readable-values-remapped-chain-filter-search field-id @v->human-readable constraints query options)
(and (search-cached-field-values? field-id constraints) (nil? @the-remapped-field-id))
(cached-field-values-search field-id query constraints options)
(some? @the-remapped-field-id)
(unremapped-chain-filter-search @the-remapped-field-id constraints query (assoc options :original-field-id field-id))
:else
(unremapped-chain-filter-search field-id constraints query options)))) | |
------------------ Filterable Field IDs (powers GET /api/dashboard/params/valid-filter-fields) ------------------- | |
Return the subset of ;; maybe we can't filter against Field 2 because there's no FK-> relationship (filterable-field-ids 1 #{2 3 4}) ; -> #{3 4} | (mu/defn filterable-field-ids
[field-id :- ms/PositiveInt
filter-field-ids :- [:maybe [:set ms/PositiveInt]]]
(when (seq filter-field-ids)
(let [mbql-query (chain-filter-mbql-query field-id
(for [id filter-field-ids]
{:field-id id :op := :value nil})
nil)]
(set (mbql.u/match (-> mbql-query :query :filter)
[:field (id :guard integer?) _] id))))) |
(ns metabase.models.params.chain-filter.dedupe-joins (:require [clojure.core.logic :as l] [clojure.set :as set])) | |
A relation such that the left-hand side (LHS) of | (defn- lhso
[join lhs]
(l/featurec join {:lhs {:table lhs}})) |
A relation such that the right-hand side (RHS) of | (defn- rhso
[join rhs]
(l/featurec join {:rhs {:table rhs}})) |
A psuedo-relation such that goal | (defn- anyg
[g coll]
(l/conda
((l/fresh [head]
(l/firsto coll head)
(g head)))
((l/fresh [more]
(l/resto coll more)
(anyg g more))))) |
A relation such that | (defn- has-joino [joins rhs] (anyg #(rhso % rhs) joins)) |
True if | (defn- parent-joino
[join-1 join-2]
(l/fresh [id]
(rhso join-1 id)
(lhso join-2 id))) |
A relation such that | (defn- list-beforeo
[lst sublist item]
#_:clj-kondo/ignore
(l/matcha [lst sublist]
([[] []])
([[item . _] []])
([[?x . ?list-more] [?x . ?sublist-more]]
(list-beforeo ?list-more ?sublist-more item)))) |
A relationship such that the parent join of | (defn- parent-beforeo
[joins join]
(l/fresh [joins-before parent]
(list-beforeo joins joins-before join)
(parent-joino parent join)
(l/membero parent joins-before))) |
A relationship such that all RHS tables in | (defn- distinct-rhso
[joins]
(let [rhses (vec (l/lvars (count joins)))]
(dorun (map rhso joins rhses))
(l/all
(l/distincto rhses)))) |
Remove unnecessary joins from a collection of
| (defn dedupe-joins
[source-id in-joins keep-ids]
;; we can't keep any joins that don't exist in `in-joins`, so go ahead and remove IDs for those joins if they're not
;; present
(let [keep-ids (set/intersection (set keep-ids)
(set (map #(get-in % [:rhs :table]) in-joins)))]
(first
(some
seq
(for [num-joins (range (count keep-ids) (inc (count in-joins)))]
(let [out-joins (vec (l/lvars num-joins))]
(l/run 1 [q]
(l/== q out-joins)
;; every join in out-joins must be present in the original non-deduped set of joins
(l/everyg (fn [join]
(l/membero join in-joins))
out-joins)
;; no duplicate joins (this is mostly for optimization since we also deduplicate RHSes below)
(l/distincto out-joins)
;; a join for every rhs must be present
(l/everyg (fn [id]
(has-joino out-joins id))
keep-ids)
;; no duplicate rhses
(distinct-rhso out-joins)
;; joins must be in order (e.g. parent join must come first)
(l/everyg (fn [join]
(l/conda
;; either the LHS is the source Table...
((lhso join source-id))
;; or its LHS must have already been joined
((parent-beforeo out-joins join))))
out-joins)))))))) |
Custom values for Parameters. A parameter with custom values will need to define a source: - static-list: the values is pre-defined and stored inside parameter's config - card: the values is a column from a saved question | (ns metabase.models.params.custom-values (:require [clojure.string :as str] [metabase.models.card :refer [Card]] [metabase.models.interface :as mi] [metabase.query-processor :as qp] [metabase.query-processor.util :as qp.util] [metabase.search.util :as search.util] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
Filters for values that match Values could have 2 shapes - [[value1], [value2]] - [[value2, label2], [value2, label2]] - we search using label in this case ------------------------------------------------- source=static-list -------------------------------------------------- | (defn- query-matches
[query values]
(let [normalized-query (search.util/normalize query)]
(filter (fn [v] (str/includes? (search.util/normalize (if (= (count v) 1)
(first v)
(second v)))
normalized-query)) values))) |
(defn- static-list-values
[{values-source-options :values_source_config :as _param} query]
(when-let [values (:values values-source-options)]
(let [wrapped-values (map (fn [v] (if-not (sequential? v) [v] v)) values)]
{:values (if query
(query-matches query wrapped-values)
wrapped-values)
:has_more_values false}))) | |
---------------------------------------------------- source=card ------------------------------------------------------ | |
Maximum number of rows returned when running a card. It's 1000 because it matches with the limit for chain-filter. Maybe we should lower it for the sake of displaying a parameter dropdown. | (def ^:dynamic *max-rows* 1000) |
(defn- values-from-card-query
[card value-field query]
(let [value-base-type (:base_type (qp.util/field->field-info value-field (:result_metadata card)))
expressions (get-in card [:dataset_query :query :expressions])]
{:database (:database_id card)
:type :query
:query (merge
(cond-> {:source-table (format "card__%d" (:id card))
:breakout [value-field]
:limit *max-rows*}
expressions
(assoc :expressions expressions))
{:filter [:and
[(if (isa? value-base-type :type/Text)
:not-empty
:not-null)
value-field]
(when query
(if-not (isa? value-base-type :type/Text)
[:= value-field query]
[:contains [:lower value-field] (u/lower-case-en query)]))]})
:middleware {:disable-remaps? true}})) | |
Get distinct values of a field from a card. (values-from-card 1 [:field "name" nil] "red") ;; will execute a mbql that looks like ;; {:source-table (format "card__%d" card-id) ;; :fields [value-field] ;; :breakout [value-field] ;; :filter [:contains [:lower value-field] "red"] ;; :limit max-rows} => {:values [["Red Medicine"]] :hasmorevalues false} | (mu/defn values-from-card
([card value-field]
(values-from-card card value-field nil))
([card :- (ms/InstanceOf Card)
value-field :- ms/Field
query :- [:any]]
(let [mbql-query (values-from-card-query card value-field query)
result (qp/process-query mbql-query)
values (get-in result [:data :rows])]
{:values values
;; if the row_count returned = the limit we specified, then it's probably has more than that
:has_more_values (= (:row_count result)
(get-in mbql-query [:query :limit]))}))) |
Given a param and query returns the values. | (defn card-values
[{config :values_source_config :as _param} query]
(let [card-id (:card_id config)
card (t2/select-one Card :id card-id)]
(values-from-card card (:value_field config) query))) |
(defn- can-get-card-values?
[card value-field]
(boolean
(and (not (:archived card))
(some? (qp.util/field->field-info value-field (:result_metadata card)))))) | |
--------------------------------------------- Putting it together ---------------------------------------------- | |
(mu/defn parameter->values :- ms/FieldValuesResult
"Given a parameter with a custom-values source, return the values.
`default-case-thunk` is a 0-arity function that returns values list when:
- :values_source_type = card but the card is archived or the card no longer contains the value-field.
- :values_source_type = nil."
[parameter query default-case-thunk]
(case (:values_source_type parameter)
"static-list" (static-list-values parameter query)
"card" (let [card (t2/select-one Card :id (get-in parameter [:values_source_config :card_id]))]
(when-not (mi/can-read? card)
(throw (ex-info "You don't have permissions to do that." {:status-code 403})))
(if (can-get-card-values? card (get-in parameter [:values_source_config :value_field]))
(card-values parameter query)
(default-case-thunk)))
nil (default-case-thunk)
(throw (ex-info (tru "Invalid parameter source {0}" (:values_source_type parameter))
{:status-code 400
:parameter parameter})))) | |
Code related to fetching FieldValues for Fields to populate parameter widgets. Always used by the field
values ( | (ns metabase.models.params.field-values (:require [medley.core :as m] [metabase.models.field :as field] [metabase.models.field-values :as field-values :refer [FieldValues]] [metabase.models.interface :as mi] [metabase.plugins.classloader :as classloader] [metabase.public-settings.premium-features :refer [defenterprise]] [metabase.util :as u] [toucan2.core :as t2])) |
OSS implementation; used as a fallback for the EE implementation if the field isn't sandboxed. | (defn default-get-or-create-field-values-for-current-user! [field] (field-values/get-or-create-full-field-values! field)) |
Fetch cached FieldValues for a | (defenterprise get-or-create-field-values-for-current-user!* metabase-enterprise.sandbox.models.params.field-values [field] (default-get-or-create-field-values-for-current-user! field)) |
Whether the current User has permissions to fetch FieldValues for a | (defn current-user-can-fetch-field-values? [field] ;; read permissions for a Field = partial permissions for its parent Table (including EE segmented permissions) (mi/can-read? field)) |
Format a FieldValues to use by params functions. ;; (postprocess-field-values (t2/select-one FieldValues :id 1) (Field 1)) ;; => {:values [[1] [2] [3] [4]] :field_id 1 :hasmorevalues boolean} | (defn- postprocess-field-values
[field-values field]
(if field-values
(-> field-values
(assoc :values (field-values/field-values->pairs field-values))
(select-keys [:values :field_id :has_more_values]))
{:values [], :field_id (u/the-id field), :has_more_values false})) |
OSS implementation; used as a fallback for the EE implementation for any fields that aren't subject to sandboxing. | (defn default-field-id->field-values-for-current-user
[field-ids]
(when (seq field-ids)
(not-empty
(let [fields (-> (t2/select :model/Field :id [:in (set field-ids)])
(field/readable-fields-only)
(t2/hydrate :values))
field-values (->> (map #(select-keys (field-values/get-or-create-full-field-values! %)
[:field_id :human_readable_values :values])
fields)
(keep not-empty))]
(m/index-by :field_id field-values))))) |
Fetch existing FieldValues for a sequence of | (defenterprise field-id->field-values-for-current-user metabase-enterprise.sandbox.models.params.field-values [field-ids] (default-field-id->field-values-for-current-user field-ids)) |
+----------------------------------------------------------------------------------------------------------------+ | Advanced FieldValues | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- fetch-advanced-field-values
[fv-type field constraints]
{:pre [(field-values/advanced-field-values-types fv-type)]}
(case fv-type
:linked-filter
(do
(classloader/require 'metabase.models.params.chain-filter)
(let [{:keys [values has_more_values]} ((resolve 'metabase.models.params.chain-filter/unremapped-chain-filter)
(:id field) constraints {})
;; we have a hard limit for how many values we want to store in FieldValues,
;; let's make sure we respect that limit here.
;; For a more detailed docs on this limt check out [[field-values/distinct-values]]
limited-values (field-values/take-by-length field-values/*total-max-length* values)]
{:values limited-values
:has_more_values (or (> (count values)
(count limited-values))
has_more_values)}))
(field-values/distinct-values field))) | |
Returns hash-key for Advanced FieldValues by types. | (defn hash-key-for-advanced-field-values
[fv-type field-id constraints]
(case fv-type
:linked-filter
(field-values/hash-key-for-linked-filters field-id constraints)
:sandbox
(field-values/hash-key-for-sandbox field-id)
:impersonation
(field-values/hash-key-for-impersonation field-id))) |
Fetch and create a FieldValues for | (defn create-advanced-field-values!
[fv-type field hash-key constraints]
(when-let [{wrapped-values :values
:keys [has_more_values]} (fetch-advanced-field-values fv-type field constraints)]
(let [;; each value in `wrapped-values` is a 1-tuple, so unwrap the raw values for storage
values (map first wrapped-values)
;; If the full FieldValues of this field has a human-readable-values, fix it with the new values
human-readable-values (field-values/fixup-human-readable-values
(t2/select-one FieldValues
:field_id (:id field)
:type :full)
values)]
(first (t2/insert-returning-instances! FieldValues
:field_id (:id field)
:type fv-type
:hash_key hash-key
:has_more_values has_more_values
:human_readable_values human-readable-values
:values values))))) |
Fetch an Advanced FieldValues with type | (defn get-or-create-advanced-field-values!
([fv-type field]
(get-or-create-advanced-field-values! fv-type field nil))
([fv-type field constraints]
(let [hash-key (hash-key-for-advanced-field-values fv-type (:id field) constraints)
fv (or (t2/select-one FieldValues :field_id (:id field)
:type fv-type
:hash_key hash-key)
(create-advanced-field-values! fv-type field hash-key constraints))]
(cond
(nil? fv) nil
;; If it's expired, delete then try to re-create it
(field-values/advanced-field-values-expired? fv) (do
(t2/delete! FieldValues :id (:id fv))
(recur fv-type field constraints))
:else fv)))) |
+----------------------------------------------------------------------------------------------------------------+ | Public functions | +----------------------------------------------------------------------------------------------------------------+ | |
Fetch FieldValues for a | (defn get-or-create-field-values-for-current-user!
[field]
(-> (get-or-create-field-values-for-current-user!* field)
(postprocess-field-values field))) |
Fetch linked-filter FieldValues for a | (defn get-or-create-linked-filter-field-values!
[field constraints]
(-> (get-or-create-advanced-field-values! :linked-filter field constraints)
(postprocess-field-values field))) |
Low-level Metabase permissions system definition and utility functions. The Metabase permissions system is based around permissions paths that are granted to individual [[metabase.models.permissions-group]]s. Core conceptsPermissions are granted to individual [[metabase.models.permissions-group]]s, and Users are members of one or more
Permissions Groups. Permissions Groups are like 'roles' in other permissions systems. There are a few 'magic'
Permissions Groups: the [[metabase.models.permissions-group/all-users]] Group, of which every User is a member and
cannot be removed; and the [[metabase.models.permissions-group/admin]] Group, of which every superuser (i.e., every
User with The permissions needed to perform an action are represented as slash-delimited path strings, for example
Permissions paths use a prefix system where a User is normally allowed to perform any action if one of their Groups
has any permissions entry that is a prefix for the permission required to perform that action. For example, if
reading Database 1 requires the permission This prefix system allows us to easily and efficiently query the application database to find relevant matching
permissions matching an path or path using The union of all permissions the current User's gets from all groups of which they are a member are automatically bound to [[metabase.api.common/current-user-permissions-set]] by [[metabase.server.middleware.session/bind-current-user]] for every REST API request, and in other places when queries are ran in a non-API thread (e.g. for scheduled Dashboard Subscriptions). Different types of permissionsThere are two main types of permissions:
Enterprise-only permissions and "anti-permissions"In addition to data permissions and Collection permissions, a User can also be granted four additional types of permissions.
Determining CRUD permissions in the REST APIREST API permissions checks are generally done in various The implementation of these methods is up to individual models. The majority of implementations check whether [[metabase.api.common/current-user-permissions-set]] includes permissions for a given path (action) using [[set-has-full-permissions?]], or for a set of paths using [[set-has-full-permissions-for-set?]]. Other implementations check whether a user has partial permissions for a path or set
using [[set-has-partial-permissions?]] or [[set-has-partial-permissions-for-set?]]. Partial permissions means that
the User has permissions for some subpath of the path in question, e.g. Determining query permissionsNormally, a User is allowed to view (i.e., run the query for) a Saved Question if they have read permissions for the Collection in which Saved Question lives, or if they have data permissions for the Database and Table(s) the Question accesses. The main idea here is that some Users with more permissions can go create a curated set of Saved Questions they deem appropriate for less-privileged Users to see, and put them in a Collection they can see. These Users would still be prevented from poking around things on their own, however. The Query Processor middleware in [[metabase.query-processor.middleware.permissions]], [[metabase-enterprise.sandbox.query-processor.middleware.row-level-restrictions]], and [[metabase-enterprise.advanced-permissions.models.permissions.block-permissions]] determines whether the current User has permissions to run the current query. Permissions are as follows: | Data perms? | Coll perms? | Block? | Segmented? | Can run? | | ----------- | ----------- | ------ | ---------- | -------- | | no | no | no | no | ⛔ | | no | no | no | yes | ⚠️ | | no | no | yes | no | ⛔ | | no | no | yes | yes | ⚠️ | | no | yes | no | no | ✅ | | no | yes | no | yes | ⚠️ | | no | yes | yes | no | ⛔ | | no | yes | yes | yes | ⚠️ | | yes | no | no | no | ✅ | | yes | no | no | yes | ✅ | | yes | no | yes | no | ✅ | | yes | no | yes | yes | ✅ | | yes | yes | no | no | ✅ | | yes | yes | no | yes | ✅ | | yes | yes | yes | no | ✅ | | yes | yes | yes | yes | ✅ | ( Known Permissions PathsSee [[path-regex-v1]] for an always-up-to-date list of permissions paths. /collection/:id/ ; read-write perms for a Coll and its non-Coll children /collection/:id/read/ ; read-only perms for a Coll and its non-Coll children /collection/root/ ; read-write perms for the Root Coll and its non-Coll children /colllection/root/read/ ; read-only perms for the Root Coll and its non-Coll children /collection/namespace/:namespace/root/ ; read-write perms for the Root Coll of a non-default namespace (e.g. SQL Snippets) /collection/namespace/:namespace/root/read/ ; read-only perms for the Root Coll of a non-default namespace (e.g. SQL Snippets) /db/:id/ ; full perms for a Database /db/:id/native/ ; ad-hoc native query perms for a Database /db/:id/schema/ ; ad-hoc MBQL query perms for all schemas in DB (does not include native queries) /db/:id/schema/:name/ ; ad-hoc MBQL query perms for a specific schema /db/:id/schema/:name/table/:id/ ; full perms for a Table /db/:id/schema/:name/table/:id/read/ ; perms to fetch info about this Table from the DB /db/:id/schema/:name/table/:id/query/ ; ad-hoc MBQL query perms for a Table /db/:id/schema/:name/table/:id/query/segmented/ ; allow ad-hoc MBQL queries. Sandbox all queries against this Table. /block/db/:id/ ; disallow queries against this DB unless User has data perms. / ; full root perms | (ns metabase.models.permissions
(:require
[clojure.data :as data]
[clojure.string :as str]
[clojure.walk :as walk]
[malli.core :as mc]
[medley.core :as m]
[metabase.api.common :refer [*current-user-id*]]
[metabase.api.permission-graph :as api.permission-graph]
[metabase.config :as config]
[metabase.models.interface :as mi]
[metabase.models.permissions-group :as perms-group]
[metabase.models.permissions-revision
:as perms-revision
:refer [PermissionsRevision]]
[metabase.models.permissions.parse :as perms-parse]
[metabase.permissions.util :as perms.u]
[metabase.plugins.classloader :as classloader]
[metabase.public-settings.premium-features
:as premium-features
:refer [defenterprise]]
[metabase.util :as u]
[metabase.util.honey-sql-2 :as h2x]
[metabase.util.i18n :refer [trs tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[methodical.core :as methodical]
[toucan2.core :as t2])) |
+----------------------------------------------------------------------------------------------------------------+ | UTIL FNS | +----------------------------------------------------------------------------------------------------------------+ | |
-------------------------------------------------- Dynamic Vars -------------------------------------------------- | |
Should we allow permissions entries like | (def ^:dynamic ^Boolean *allow-root-entries* false) |
Should we allow changes to be made to permissions belonging to the Admin group? By default this is disabled to
prevent accidental tragedy, but you can enable it here when creating the default entry for | (def ^:dynamic ^Boolean *allow-admin-permissions-changes* false) |
--------------------------------------------------- Assertions --------------------------------------------------- | |
Check to make sure the | (defn- assert-not-admin-group
[{:keys [group_id]}]
(when (and (= group_id (:id (perms-group/admin)))
(not *allow-admin-permissions-changes*))
(throw (ex-info (tru "You cannot create or revoke permissions for the ''Admin'' group.")
{:status-code 400})))) |
Check to make sure the value of | (defn- assert-valid-object
[{:keys [object]}]
(when (and object
(not (perms.u/valid-path? object))
(or (not= object "/")
(not *allow-root-entries*)))
(throw (ex-info (tru "Invalid permissions object path: ''{0}''." object)
{:status-code 400, :path object})))) |
Check to make sure this | (defn- assert-valid
[permissions]
(doseq [f [assert-not-admin-group
assert-valid-object]]
(f permissions))) |
------------------------------------------------- Path Util Fns -------------------------------------------------- | |
(def ^:private MapOrID [:or :map ms/PositiveInt]) | |
(mu/defn data-perms-path :- perms.u/PathSchema "Return the [readwrite] permissions path for a Database, schema, or Table. (At the time of this writing, DBs and schemas don't have separate `read/` and write permissions; you either have 'data access' permissions for them, or you don't. Tables, however, have separate read and write perms.)" ([database-or-id :- MapOrID] (str "/db/" (u/the-id database-or-id) "/")) ([database-or-id :- MapOrID schema-name :- [:maybe :string]] (str (data-perms-path database-or-id) "schema/" (perms.u/escape-path-component schema-name) "/")) ([database-or-id :- MapOrID schema-name :- [:maybe :string] table-or-id :- MapOrID] (str (data-perms-path database-or-id schema-name) "table/" (u/the-id table-or-id) "/"))) | |
(mu/defn adhoc-native-query-path :- perms.u/PathSchema "Return the native query read/write permissions path for a database. This grants you permissions to run arbitary native queries." [database-or-id :- MapOrID] (str (data-perms-path database-or-id) "native/")) | |
(mu/defn all-schemas-path :- perms.u/PathSchema "Return the permissions path for a database that grants full access to all schemas." [database-or-id :- MapOrID] (str (data-perms-path database-or-id) "schema/")) | |
(mu/defn collection-readwrite-path :- perms.u/PathSchema
"Return the permissions path for *readwrite* access for a `collection-or-id`."
[collection-or-id :- MapOrID]
(if-not (get collection-or-id :metabase.models.collection.root/is-root?)
(format "/collection/%d/" (u/the-id collection-or-id))
(if-let [collection-namespace (:namespace collection-or-id)]
(format "/collection/namespace/%s/root/" (perms.u/escape-path-component (u/qualified-name collection-namespace)))
"/collection/root/"))) | |
(mu/defn collection-read-path :- perms.u/PathSchema "Return the permissions path for *read* access for a `collection-or-id`." [collection-or-id :- MapOrID] (str (collection-readwrite-path collection-or-id) "read/")) | |
(mu/defn table-read-path :- perms.u/PathSchema
"Return the permissions path required to fetch the Metadata for a Table."
([table-or-id]
(if (integer? table-or-id)
(recur (t2/select-one ['Table :db_id :schema :id] :id table-or-id))
(table-read-path (:db_id table-or-id) (:schema table-or-id) table-or-id)))
([database-or-id schema-name table-or-id]
{:post [(perms.u/valid-path? %)]}
(str (data-perms-path (u/the-id database-or-id) schema-name (u/the-id table-or-id)) "read/"))) | |
(mu/defn table-query-path :- perms.u/PathSchema
"Return the permissions path for *full* query access for a Table. Full query access means you can run any (MBQL) query
you wish against a given Table, with no GTAP-specified mandatory query alterations."
([table-or-id]
(if (integer? table-or-id)
(recur (t2/select-one ['Table :db_id :schema :id] :id table-or-id))
(table-query-path (:db_id table-or-id) (:schema table-or-id) table-or-id)))
([database-or-id schema-name table-or-id]
(str (data-perms-path (u/the-id database-or-id) schema-name (u/the-id table-or-id)) "query/"))) | |
(mu/defn table-sandboxed-query-path :- perms.u/PathSchema
"Return the permissions path for *segmented* query access for a Table. Segmented access means running queries against
the Table will automatically replace the Table with a GTAP-specified question as the new source of the query,
obstensibly limiting access to the results."
([table-or-id]
(if (integer? table-or-id)
(recur (t2/select-one ['Table :db_id :schema :id] :id table-or-id))
(table-sandboxed-query-path (:db_id table-or-id) (:schema table-or-id) table-or-id)))
([database-or-id schema-name table-or-id]
(str (data-perms-path (u/the-id database-or-id) schema-name (u/the-id table-or-id)) "query/segmented/"))) | |
(mu/defn database-block-perms-path :- perms.u/PathSchema "Return the permissions path for the Block 'anti-permissions'. Block anti-permissions means a User cannot run a query against a Database unless they have data permissions, regardless of whether segmented permissions would normally give them access or not." [database-or-id :- MapOrID] (str "/block" (data-perms-path database-or-id))) | |
(mu/defn base->feature-perms-path :- perms.u/PathSchema
"Returns the permissions path to use for a given permission type (e.g. download) and value (e.g. full or limited),
given the 'base' permissions path for an entity (the base path is equivalent to the one used for data access
permissions)."
[perm-type perm-value base-path]
(case [perm-type perm-value]
[:download :full]
(str "/download" base-path)
[:download :limited]
(str "/download/limited" base-path)
[:data-model :all]
(str "/data-model" base-path)
[:details :yes]
(str "/details" base-path)
[:execute :all]
(str "/execute" base-path))) | |
(mu/defn feature-perms-path :- perms.u/PathSchema "Returns the permissions path to use for a given feature-level permission type (e.g. download) and value (e.g. full or limited), for a database, schema or table." [perm-type perm-value & path-components] (base->feature-perms-path perm-type perm-value (apply data-perms-path path-components))) | |
(mu/defn native-feature-perms-path :- perms.u/PathSchema "Returns the native permissions path to use for a given feature-level permission type (e.g. download) and value (e.g. full or limited)." [perm-type perm-value database-or-id] (base->feature-perms-path perm-type perm-value (adhoc-native-query-path database-or-id))) | |
(mu/defn data-model-write-perms-path :- perms.u/PathSchema
"Returns the permission path required to edit the table specified by the provided args, or a field in the table.
If Enterprise Edition code is available, and a valid :advanced-permissions token is present, returns the data model
permissions path for the table. Otherwise, defaults to the root path ('/'), thus restricting writes to admins."
[& path-components]
(let [f (when config/ee-available?
(classloader/require 'metabase-enterprise.advanced-permissions.models.permissions)
(resolve 'metabase-enterprise.advanced-permissions.models.permissions/data-model-write-perms-path))]
(if (and f (premium-features/enable-advanced-permissions?))
(apply f path-components)
"/"))) | |
(mu/defn db-details-write-perms-path :- perms.u/PathSchema
"Returns the permission path required to edit the table specified by the provided args, or a field in the table.
If Enterprise Edition code is available, and a valid :advanced-permissions token is present, returns the DB details
permissions path for the table. Otherwise, defaults to the root path ('/'), thus restricting writes to admins."
[db-id]
(let [f (when config/ee-available?
(classloader/require 'metabase-enterprise.advanced-permissions.models.permissions)
(resolve 'metabase-enterprise.advanced-permissions.models.permissions/db-details-write-perms-path))]
(if (and f (premium-features/enable-advanced-permissions?))
(f db-id)
"/"))) | |
(mu/defn application-perms-path :- perms.u/PathSchema
"Returns the permissions path for *full* access a application permission."
[perm-type]
(case perm-type
:setting
"/application/setting/"
:monitoring
"/application/monitoring/"
:subscription
"/application/subscription/")) | |
-------------------------------------------- Permissions Checking Fns -------------------------------------------- | |
Does | (defn is-permissions-for-object? [permissions-path path] (str/starts-with? path permissions-path)) |
Does | (defn is-partial-permissions-for-object?
[permissions-path path]
(or (is-permissions-for-object? permissions-path path)
(str/starts-with? permissions-path path))) |
Does | (defn set-has-full-permissions? ^Boolean [permissions-set path] (boolean (some #(is-permissions-for-object? % path) permissions-set))) |
Does | (defn set-has-partial-permissions? ^Boolean [permissions-set path] (boolean (some #(is-partial-permissions-for-object? % path) permissions-set))) |
(mu/defn set-has-full-permissions-for-set? :- :boolean
"Do the permissions paths in `permissions-set` grant *full* access to all the object paths in `paths-set`?"
[permissions-set paths-set]
(every? (partial set-has-full-permissions? permissions-set)
paths-set)) | |
(mu/defn set-has-partial-permissions-for-set? :- :boolean
"Do the permissions paths in `permissions-set` grant *partial* access to all the object paths in `paths-set`?
(`permissions-set` must grant partial access to *every* object in `paths-set` set)."
[permissions-set paths-set]
(every? (partial set-has-partial-permissions? permissions-set)
paths-set)) | |
(mu/defn set-has-any-native-query-permissions? :- :boolean
"Do the permission paths in `permission-set` grant native query access to any database?"
[permissions-set]
(boolean
;; Matches "/", "/db/:id/", or "/db/:id/native/"
(some
#(first (re-find #"^/(db/\d+/(native/)?)?$" %))
permissions-set))) | |
(mu/defn set-has-application-permission-of-type? :- :boolean "Does `permissions-set` grant *full* access to a application permission of type `perm-type`?" [permissions-set perm-type] (set-has-full-permissions? permissions-set (application-perms-path perm-type))) | |
(mu/defn perms-objects-set-for-parent-collection :- [:set perms.u/PathSchema]
"Implementation of `perms-objects-set` for models with a `collection_id`, such as Card, Dashboard, or Pulse.
This simply returns the `perms-objects-set` of the parent Collection (based on `collection_id`) or for the Root
Collection if `collection_id` is `nil`."
([this read-or-write]
(perms-objects-set-for-parent-collection nil this read-or-write))
([collection-namespace :- [:maybe ms/KeywordOrString]
this :- [:map
[:collection_id [:maybe ms/PositiveInt]]]
read-or-write :- [:enum :read :write]]
;; based on value of read-or-write determine the approprite function used to calculate the perms path
(let [path-fn (case read-or-write
:read collection-read-path
:write collection-readwrite-path)]
;; now pass that function our collection_id if we have one, or if not, pass it an object representing the Root
;; Collection
#{(path-fn (or (:collection_id this)
{:metabase.models.collection.root/is-root? true
:namespace collection-namespace}))}))) | |
(doto ::use-parent-collection-perms (derive ::mi/read-policy.full-perms-for-perms-set) (derive ::mi/write-policy.full-perms-for-perms-set)) | |
(defmethod mi/perms-objects-set ::use-parent-collection-perms [instance read-or-write] (perms-objects-set-for-parent-collection instance read-or-write)) | |
+----------------------------------------------------------------------------------------------------------------+ | ENTITY + LIFECYCLE | +----------------------------------------------------------------------------------------------------------------+ | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase. | (def Permissions :model/Permissions) |
(methodical/defmethod t2/table-name :model/Permissions [_model] :permissions) | |
(derive :model/Permissions :metabase/model) | |
(t2/define-before-insert :model/Permissions
[permissions]
(u/prog1 permissions
(assert-valid permissions)
(log/debug (u/colorize 'green (trs "Granting permissions for group {0}: {1}"
(:group_id permissions)
(:object permissions)))))) | |
(t2/define-before-update :model/Permissions [_] (throw (Exception. (tru "You cannot update a permissions entry! Delete it and create a new one.")))) | |
(t2/define-before-delete :model/Permissions
[permissions]
(log/debug (u/colorize 'red (trs "Revoking permissions for group {0}: {1}"
(:group_id permissions)
(:object permissions))))
(assert-not-admin-group permissions)) | |
+----------------------------------------------------------------------------------------------------------------+ | GRAPH SCHEMA | +----------------------------------------------------------------------------------------------------------------+ | |
The stuff below is all for the data permissions graph. We have a separate graph for Collection permissions, and code to work with it lives in [[metabase.models.collection.graph]]. | |
TODO - there is so much stuff related to the perms graph I think we should really move it into a separate
| |
(def ^:private TablePermissionsGraph
[:or
{:error/message "Valid perms graph for a Table"}
[:enum :none :all]
[:and
[:map
[:read {:optional true} [:enum :all :none]]
[:query {:optional true} [:enum :all :segmented :none]]]
[:fn
{:error/message "non-empty map"}
not-empty]]]) | |
(def ^:private SchemaPermissionsGraph
[:or
{:error/message "Valid perms graph for a schema"}
[:enum :none :all]
[:map-of ms/PositiveInt TablePermissionsGraph]]) | |
(def ^:private NativePermissionsGraph
[:enum {:error/message "Valid native perms option for a database"} :write :none]) | |
Schema for execution permission values. | (def ExecutePermissions
[:enum {:error/message "Valid execute perms option type"} :all :none]) |
The "Strict" versions of the various graphs below are intended for schema checking when updating the permissions graph. In other words, we shouldn't be stopped from returning the graph if it violates the "strict" rules, but we should refuse to update the graph unless it matches the strict schema. TODO - It might be possible at some point in the future to just use the strict versions everywhere TODO -- instead of doing schema validation, why don't we just throw an Exception so the API responses are actually somewhat useful? | (def ^:private DownloadTablePermissionsGraph
[:enum {:error/message "Valid download perms graph for a table"} :full :limited :none]) |
(def ^:private DownloadSchemaPermissionsGraph
[:or
{:error/message "Valid download perms graph for a schema"}
[:enum :full :limited :none]
[:map-of ms/PositiveInt DownloadTablePermissionsGraph]]) | |
(def ^:private DownloadNativePermissionsGraph
[:enum {:error/message "Valid download perms option for native queries over a database"} :full :limited :none]) | |
Schema for a download permissions graph, used in [[metabase-enterprise.advanced-permissions.models.permissions]]. | (def DownloadPermissionsGraph
[:map
{:error/message "Valid download perms graph for a database"}
[:native {:optional true} DownloadNativePermissionsGraph]
[:schemas {:optional true} [:or
[:enum :full :limited :none]
[:map-of :string DownloadSchemaPermissionsGraph]]]]) |
(def ^:private DataModelTablePermissionsGraph
[:enum {:error/message "Valid data model perms graph for a table"} :all :none]) | |
(def ^:private DataModelSchemaPermissionsGraph
[:or
{:error/message "Valid data model perms graph for a schema"}
[:enum :all :none]
[:map-of ms/PositiveInt DataModelTablePermissionsGraph]]) | |
Schema for a data model permissions graph, used in [[metabase-enterprise.advanced-permissions.models.permissions]]. | (def DataModelPermissionsGraph
[:map
{:error/message "Valid data model perms graph for a database"}
[:schemas [:or
[:enum :all :none]
[:map-of :string DataModelSchemaPermissionsGraph]]]]) |
Schema for a database details permissions, used in [[metabase-enterprise.advanced-permissions.models.permissions]]. | (def DetailsPermissions
[:enum {:error/message "Valid details perms graph for a database"} :yes :no]) |
(def ^:private ExecutionGroupPermissionsGraph [:or ExecutePermissions [:map-of ms/PositiveInt ExecutePermissions]]) | |
(def ^:private ExecutionPermissionsGraph [:map [:revision :int] [:groups [:map-of ms/PositiveInt ExecutionGroupPermissionsGraph]]]) | |
+----------------------------------------------------------------------------------------------------------------+ | GRAPH FETCH | +----------------------------------------------------------------------------------------------------------------+ | |
Handle '/' permission | (defn- all-permissions
[db-ids]
(into {}
(map (fn [db-id]
[db-id {:data {:native :write :schemas :all}
:download {:native :full :schemas :full}
:data-model { :schemas :all}
:details :yes}])
db-ids))) |
(defn- permissions-by-group-ids [where-clause]
(let [permissions (t2/select [Permissions [:group_id :group-id] [:object :path]]
{:where where-clause})]
(reduce (fn [m {:keys [group-id path]}]
(update m group-id conj path))
{}
permissions))) | |
Augment the permissions graph with active connection impersonation policies. OSS implementation returns graph as-is. | (defenterprise add-impersonations-to-permissions-graph metabase-enterprise.advanced-permissions.models.connection-impersonation [graph] graph) |
(defn- post-process-graph [graph]
(->>
graph
(walk/postwalk-replace {{:query {:schemas :all}} {:query {:schemas :all :native :none}}
{:query {:schemas :all :native nil}} {:query {:schemas :all :native :none}}}))) | |
(mu/defn generate-graph :- :map
"Used to generation permission graph from parsed permission paths of v1 and v2 permission graphs for the api layer."
[db-ids group-id->paths :- [:map-of :int [:* perms.u/Path]]]
(->> group-id->paths
(m/map-vals
(fn [paths]
(let [permissions-graph (perms-parse/->graph paths)]
(if (= permissions-graph :all)
(all-permissions db-ids)
(:db permissions-graph)))))
post-process-graph
add-impersonations-to-permissions-graph)) | |
keep v1 paths, implicitly remove v2 | (defn ->v1-paths
[group-id->permissions]
(m/map-vals (fn [paths]
(filter (fn [path] (mc/validate [:re perms.u/path-regex-v1] path)) paths))
group-id->permissions)) |
Fetch a graph representing the current data permissions status for every Group and all permissioned databases. See [[metabase.models.collection.graph]] for the Collection permissions graph code. Keeps v1 paths, hence implictly removes v2 paths. What are v1 and v2 permissions? see: [[classify-path]]. In summary:
|--------------------------------| | | v1-data, block | all-other-paths | v2-data, v2-query | | |-----------------------------------| v2 permissions | (defn data-perms-graph
[]
(let [db-ids (delay (t2/select-pks-set 'Database))
group-id->v1-paths (->> (permissions-by-group-ids [:or
[:= :object (h2x/literal "/")]
[:like :object (h2x/literal "%/db/%")]])
->v1-paths)]
{:revision (perms-revision/latest-id)
:groups (generate-graph @db-ids group-id->v1-paths)})) |
Efficiently returns a data permissions graph, which has all the permissions info for | (defn data-graph-for-db
[db-id]
(let [group-id->permissions (permissions-by-group-ids [:like :object (h2x/literal (str "%/db/" db-id "/%"))])
group-id->v1-paths (->v1-paths group-id->permissions)]
{:revision (perms-revision/latest-id)
:groups (generate-graph [db-id] group-id->v1-paths)})) |
Efficiently returns a data permissions graph, which has all the permissions info for the permission group at | (defn data-graph-for-group
[group-id]
(let [db-ids (t2/select-pks-set :model/Database)
group-id->permissions (permissions-by-group-ids [:= :group_id group-id])
group-id->paths (select-keys (->v1-paths group-id->permissions) [group-id])]
{:revision (perms-revision/latest-id)
:groups (generate-graph db-ids group-id->paths)})) |
Fetch a graph representing the current data permissions status for every Group and all permissioned databases. See [[metabase.models.collection.graph]] for the Collection permissions graph code. This version of data-perms-graph removes v1 paths, implicitly keeping Only v2 style paths. What are v1 and v2 permissions? see: [[classify-path]]. In summary:
|--------------------------------| | | v1-data, block | all-other-paths | v2-data, v2-query | | |-----------------------------------| v2 permissions | (defn data-perms-graph-v2
[]
(let [db-ids (delay (t2/select-pks-set 'Database))
group-id->v2-paths (->> (permissions-by-group-ids [:or
[:= :object (h2x/literal "/")]
[:like :object (h2x/literal "%/db/%")]])
(m/map-vals (fn [paths]
;; remove v1 paths, implicitly keep v2 paths
(remove (fn [path] (mc/validate perms.u/DataPath path))
paths))))]
{:revision (perms-revision/latest-id)
:groups (generate-graph @db-ids group-id->v2-paths)})) |
Fetch a graph representing the current execution permissions status for every Group and all permissioned databases. | (defn execution-perms-graph
[]
(let [group-id->paths (permissions-by-group-ids [:or
[:= :object (h2x/literal "/")]
[:like :object (h2x/literal "/execute/%")]])
group-id->graph (m/map-vals
(fn [paths]
(let [permissions-graph (perms-parse/->graph paths)]
(if (#{:all {:execute :all}} permissions-graph)
:all
(:execute permissions-graph))))
group-id->paths)]
{:revision (perms-revision/latest-id)
:groups group-id->graph})) |
+----------------------------------------------------------------------------------------------------------------+ | GRAPH UPDATE | +----------------------------------------------------------------------------------------------------------------+ | |
--------------------------------------------------- Helper Fns --------------------------------------------------- | |
Delete all 'related' permissions for Suppose we asked this functions to delete related permssions for
In short, it will delete any permissions that contain You can optionally include NOTE: This function is meant for internal usage in this namespace only; use one of the other functions like
| (mu/defn delete-related-permissions!
{:style/indent 2}
[group-or-id :- [:or :map ms/PositiveInt] path :- perms.u/PathSchema & other-conditions]
(let [paths (conj (perms.u/->v2-path path) path)
where {:where (apply list
:and
[:= :group_id (u/the-id group-or-id)]
(into [:or
[:like path (h2x/concat :object (h2x/literal "%"))]]
(map (fn [path-form] [:like :object (str path-form "%")])
paths))
other-conditions)}]
(when-let [revoked (t2/select-fn-set :object Permissions where)]
(log/debug (u/format-color 'red "Revoking permissions for group %d: %s" (u/the-id group-or-id) revoked))
(t2/delete! Permissions where)))) |
Revoke all permissions for (revoke-data-perms! my-group my-db) TODO: rename this function to | (defn revoke-data-perms!
{:arglists '([group-or-id database-or-id]
[group-or-id database-or-id schema-name]
[group-or-id database-or-id schema-name table-or-id])}
[group-or-id & path-components]
(delete-related-permissions! group-or-id (apply data-perms-path path-components))) |
Revoke all full and limited download permissions for | (defn revoke-download-perms!
{:arglists '([group-id db-id]
[group-id db-id schema-name]
[group-id db-id schema-name table-or-id])}
[group-or-id & path-components]
(delete-related-permissions! group-or-id (apply (partial feature-perms-path :download :full) path-components))
(delete-related-permissions! group-or-id (apply (partial feature-perms-path :download :limited) path-components))) |
Grant permissions for | (defn grant-permissions!
([group-or-id db-id schema & more]
(grant-permissions! group-or-id (apply data-perms-path db-id schema more)))
([group-or-id path]
;; TEMPORARY HACK: v2 paths won't be in the graph, so they will not be seen in the old graph, so will be
;; interpreted as being new, and hence will not get deleted.
;; But we can simply delete them here:
;; This must be pulled out once the frontend is sending up a proper v2 graph.
(t2/delete! Permissions :group_id (u/the-id group-or-id) :object [:like "/query/%"])
(t2/delete! Permissions :group_id (u/the-id group-or-id) :object [:like "/data/%"])
(try
(t2/insert-returning-instances! Permissions
(map (fn [path-object]
{:group_id (u/the-id group-or-id) :object path-object})
(distinct (conj (perms.u/->v2-path path) path))))
;; on some occasions through weirdness we might accidentally try to insert a key that's already been inserted
(catch Throwable e
(log/error e (u/format-color 'red (tru "Failed to grant permissions")))
;; if we're running tests, we're doing something wrong here if duplicate permissions are getting assigned,
;; mostly likely because tests aren't properly cleaning up after themselves, and possibly causing other tests
;; to pass when they shouldn't. Don't allow this during tests
(when config/is-test?
(throw e)))))) |
Revoke all native query permissions for | (defn revoke-native-permissions! [group-or-id database-or-id] (delete-related-permissions! group-or-id (adhoc-native-query-path database-or-id))) |
Grant full readwrite permissions for | (defn grant-native-readwrite-permissions! [group-or-id database-or-id] (grant-permissions! group-or-id (adhoc-native-query-path database-or-id))) |
(defn- group-has-native-perms? [group-or-id database-or-id] (set-has-full-permissions? (t2/select-fn-set :object Permissions :group_id (u/the-id group-or-id)) (adhoc-native-query-path database-or-id))) | |
Remove all permissions entries for a DB and any child objects.
This does not revoke native permissions; use | (defn revoke-db-schema-permissions!
[group-or-id database-or-id]
(let [has-native-perms? (group-has-native-perms? group-or-id database-or-id)]
(delete-related-permissions! group-or-id (data-perms-path database-or-id)
[:not= :object (adhoc-native-query-path database-or-id)])
;; If we've removed native perms as a consequence of deleting a root database path like `/db/1/`, add them back
(when (and has-native-perms? (not (group-has-native-perms? group-or-id database-or-id)))
(grant-native-readwrite-permissions! group-or-id database-or-id)))) |
ID of Audit DB which is loaded when running an EE build. ID is placed in OSS code to facilitate permission checks. | (def audit-db-id 13371337) |
OSS implementation of | (defenterprise default-audit-collection metabase-enterprise.audit-db [] nil) |
OSS implementation of | (defenterprise default-custom-reports-collection metabase-enterprise.audit-db [] ::noop) |
Check that the changes coming in does not attempt to change audit database permission. Admins should change these permissions in application monitoring permissions. | (defn check-audit-db-permissions
[changes]
(let [changes-ids (->> changes
vals
(map keys)
(apply concat))]
(when (some #{audit-db-id} changes-ids)
(throw (ex-info (tru
(str "Audit database permissions can only be changed by updating audit collection permissions."))
{:status-code 400}))))) |
SQL clause to filter namespaces depending on if audit app is enabled or not, and if the namespace is the default one. | (defn audit-namespace-clause
[namespace-keyword namespace-val]
(if (and (nil? namespace-val) (premium-features/enable-audit-app?))
[:or [:= namespace-keyword nil] [:= namespace-keyword "analytics"]]
[:= namespace-keyword namespace-val])) |
Check if an id is one of the audit collection ids. | (defn is-collection-id-audit? [id] (contains? (set [(:id (default-audit-collection)) (:id (default-custom-reports-collection))]) id)) |
Check if an instance's parent collection is the audit collection. | (defn is-parent-collection-audit?
[instance]
(let [parent-id (:collection_id instance)]
(and (some? parent-id) (is-collection-id-audit? parent-id)))) |
Audit instances should only be fetched if audit app is enabled. | (defn can-read-audit-helper
[model instance]
(if (and (not (premium-features/enable-audit-app?))
(case model
:model/Collection (is-collection-id-audit? (:id instance))
(is-parent-collection-audit? instance)))
false
(case model
:model/Collection (mi/current-user-has-full-permissions? :read instance)
(mi/current-user-has-full-permissions? (perms-objects-set-for-parent-collection instance :read))))) |
Remove all permissions entries for a Group to access a Application permisisons | (defn revoke-application-permissions! [group-or-id perm-type] (delete-related-permissions! group-or-id (application-perms-path perm-type))) |
Grant full permissions for all schemas belonging to this database.
This does not grant native permissions; use | (defn grant-permissions-for-all-schemas! [group-or-id database-or-id] (grant-permissions! group-or-id (all-schemas-path database-or-id))) |
Grant full access to the database, including all schemas and readwrite native access. | (defn grant-full-data-permissions! [group-or-id database-or-id] (grant-permissions! group-or-id (data-perms-path database-or-id))) |
Grant full download permissions to the database. | (defn grant-full-download-permissions! [group-or-id database-or-id] (grant-permissions! group-or-id (feature-perms-path :download :full database-or-id))) |
Grant full permissions for a group to access a Application permisisons. | (defn grant-application-permissions! [group-or-id perm-type] (grant-permissions! group-or-id (application-perms-path perm-type))) |
(defn- is-personal-collection-or-descendant-of-one? [collection] (classloader/require 'metabase.models.collection) ((resolve 'metabase.models.collection/is-personal-collection-or-descendant-of-one?) collection)) | |
Check whether | (mu/defn ^:private check-not-personal-collection-or-descendant
[collection-or-id :- MapOrID]
;; don't apply this check to the Root Collection, because it's never personal
(when-not (:metabase.models.collection.root/is-root? collection-or-id)
;; ok, once we've confirmed this isn't the Root Collection, see if it's in the DB with a personal_owner_id
(let [collection (if (map? collection-or-id)
collection-or-id
(or (t2/select-one 'Collection :id (u/the-id collection-or-id))
(throw (ex-info (tru "Collection does not exist.") {:collection-id (u/the-id collection-or-id)}))))]
(when (is-personal-collection-or-descendant-of-one? collection)
(throw (Exception. (tru "You cannot edit permissions for a Personal Collection or its descendants."))))))) |
Revoke all access for | (mu/defn revoke-collection-permissions! [group-or-id :- MapOrID collection-or-id :- MapOrID] (check-not-personal-collection-or-descendant collection-or-id) (delete-related-permissions! group-or-id (collection-readwrite-path collection-or-id))) |
Grant full access to a Collection, which means a user can view all Cards in the Collection and add/remove Cards. | (mu/defn grant-collection-readwrite-permissions! [group-or-id :- MapOrID collection-or-id :- MapOrID] (check-not-personal-collection-or-descendant collection-or-id) (grant-permissions! (u/the-id group-or-id) (collection-readwrite-path collection-or-id))) |
Grant read access to a Collection, which means a user can view all Cards in the Collection. | (mu/defn grant-collection-read-permissions! [group-or-id :- MapOrID collection-or-id :- MapOrID] (check-not-personal-collection-or-descendant collection-or-id) (grant-permissions! (u/the-id group-or-id) (collection-read-path collection-or-id))) |
Delete GTAPs (sandboxes) that are no longer needed after the permissions graph is updated. This is EE-specific -- OSS impl is a no-op, since sandboxes are an EE-only feature. | (defenterprise ^:private delete-gtaps-if-needed-after-permissions-change! metabase-enterprise.sandbox.models.permissions.delete-sandboxes [_]) |
Delete connection impersonation policies that are no longer needed after the permissions graph is updated. This is EE-specific -- OSS impl is a no-op, since connection impersonation is an EE-only feature. | (defenterprise ^:private delete-impersonations-if-needed-after-permissions-change! metabase-enterprise.advanced-permissions.models.connection-impersonation [_]) |
----------------------------------------------- Graph Updating Fns ----------------------------------------------- | |
Exception to throw when a permissions operation fails due to missing Enterprise Edition code, or missing a valid token with the advanced-permissions feature. | (defn ee-permissions-exception
[perm-type]
(ex-info
(tru "The {0} permissions functionality is only enabled if you have a premium token with the advanced-permissions feature."
(str/replace (name perm-type) "-" " "))
{:status-code 402})) |
(defn- download-permissions-set
[group-id]
(t2/select-fn-set :object
[Permissions :object]
{:where [:and
[:= :group_id group-id]
[:or
[:= :object (h2x/literal "/")]
[:like :object (h2x/literal "/download/%")]]]})) | |
(defn- download-permissions-level [permissions-set db-id & [schema-name table-id]] (cond (set-has-full-permissions? permissions-set (feature-perms-path :download :full db-id schema-name table-id)) :full (set-has-full-permissions? permissions-set (feature-perms-path :download :limited db-id schema-name table-id)) :limited :else :none)) | |
Native download permissions control the ability of users to download the results of native questions for a given database. To update native download permissions, we must read the list of tables in the database, and check the group's download permission level for each one. - If they have full download permissions for all tables, they have full native download permissions. - If they have at least limited download permissions for all tables, they have limited native download permissions. - If they have no download permissions for at least one table, they have no native download permissions. This lives in non-EE code because it needs to be called during sync, in case a new table was discovered or a table was deleted. This ensures that native download perms are always up to date, even on OSS instances, in case they are upgraded to EE. | (mu/defn update-native-download-permissions!
[group-id :- ms/PositiveInt db-id :- ms/PositiveInt]
(let [permissions-set (download-permissions-set group-id)
table-ids-and-schemas (t2/select-pk->fn :schema 'Table :db_id db-id :active [:= true])
native-perm-level (reduce (fn [lowest-seen-perm-level [table-id table-schema]]
(let [table-perm-level (download-permissions-level permissions-set
db-id
table-schema
table-id)]
(cond
(= table-perm-level :none)
(reduced :none)
(or (= lowest-seen-perm-level :limited)
(= table-perm-level :limited))
:limited
:else
:full)))
:full
(seq table-ids-and-schemas))]
(doseq [perm-value [:full :limited]]
;; We don't want to call `delete-related-permissions!` here because that would also delete prefixes of the native
;; downloads path, including `/download/db/:id/`, thus removing download permissions for the entire DB. Instead
;; we just delete the native downloads path directly, so that we can replace it with a new value.
(t2/delete! Permissions :group_id group-id, :object (native-feature-perms-path :download perm-value db-id)))
(when (not= native-perm-level :none)
(grant-permissions! group-id (native-feature-perms-path :download native-perm-level db-id))))) |
(mu/defn ^:private update-table-read-permissions!
[group-id :- ms/PositiveInt
db-id :- ms/PositiveInt
schema :- :string
table-id :- ms/PositiveInt
new-read-perms :- [:enum :all :none]]
((case new-read-perms
:all grant-permissions!
:none revoke-data-perms!) group-id (table-read-path db-id schema table-id))) | |
(mu/defn ^:private update-table-query-permissions!
[group-id :- ms/PositiveInt
db-id :- ms/PositiveInt
schema :- :string
table-id :- ms/PositiveInt
new-query-perms :- [:enum :all :segmented :none]]
(case new-query-perms
:all (grant-permissions! group-id (table-query-path db-id schema table-id))
:segmented (grant-permissions! group-id (table-sandboxed-query-path db-id schema table-id))
:none (revoke-data-perms! group-id (table-query-path db-id schema table-id)))) | |
(mu/defn ^:private update-table-data-access-permissions!
[group-id :- ms/PositiveInt
db-id :- ms/PositiveInt
schema :- :string
table-id :- ms/PositiveInt
new-table-perms :- TablePermissionsGraph]
(cond
(= new-table-perms :all)
(do
(revoke-data-perms! group-id db-id schema table-id)
(grant-permissions! group-id db-id schema table-id))
(= new-table-perms :none)
(revoke-data-perms! group-id db-id schema table-id)
(map? new-table-perms)
(let [{new-read-perms :read, new-query-perms :query} new-table-perms]
;; clear out any existing permissions
(revoke-data-perms! group-id db-id schema table-id)
;; then grant/revoke read and query perms as appropriate
(when new-read-perms (update-table-read-permissions! group-id db-id schema table-id new-read-perms))
(when new-query-perms (update-table-query-permissions! group-id db-id schema table-id new-query-perms))))) | |
(mu/defn ^:private update-schema-data-access-permissions!
[group-id :- ms/PositiveInt
db-id :- ms/PositiveInt
schema :- :string
new-schema-perms :- SchemaPermissionsGraph]
(cond
(= new-schema-perms :all) (do (revoke-data-perms! group-id db-id schema) ; clear out any existing related permissions
(grant-permissions! group-id db-id schema)) ; then grant full perms for the schema
(= new-schema-perms :none) (revoke-data-perms! group-id db-id schema)
(map? new-schema-perms) (doseq [[table-id table-perms] new-schema-perms]
(update-table-data-access-permissions! group-id db-id schema table-id table-perms)))) | |
(mu/defn ^:private update-native-data-access-permissions!
[group-id :- ms/PositiveInt db-id :- ms/PositiveInt new-native-perms :- NativePermissionsGraph]
;; revoke-native-permissions! will delete all entries that would give permissions for native access. Thus if you had
;; a root DB entry like `/db/11/` this will delete that too. In that case we want to create a new full schemas entry
;; so you don't lose access to all schemas when we modify native access.
(let [has-full-access? (t2/exists? Permissions :group_id group-id, :object (data-perms-path db-id))]
(revoke-native-permissions! group-id db-id)
(when has-full-access?
(grant-permissions-for-all-schemas! group-id db-id)))
(case new-native-perms
:write (grant-native-readwrite-permissions! group-id db-id)
:none nil)) | |
(defn- delete-block-perms-for-db! [group-id db-id] (log/trace "Deleting block permissions entries for Group %d for Database %d" group-id db-id) (t2/delete! Permissions :group_id group-id, :object (database-block-perms-path db-id))) | |
(defn- revoke-schema-and-block-perms! [group-id db-id] (revoke-db-schema-permissions! group-id db-id) (delete-block-perms-for-db! group-id db-id)) | |
(mu/defn ^:private update-db-data-access-permissions!
[group-id :- pos-int?
db-id :- pos-int?
new-db-perms :- api.permission-graph/StrictDataPerms]
(when-let [new-native-perms (:native new-db-perms)]
(update-native-data-access-permissions! group-id db-id new-native-perms))
(when-let [schemas (:schemas new-db-perms)]
;; TODO -- consider whether `delete-block-perms-for-this-db!` should be enterprise-only... not sure how to make it
;; work, especially if you downgraded from enterprise... FWIW the sandboxing code (for updating the graph) is not enterprise only.
(condp = schemas
:all
(do
(revoke-schema-and-block-perms! group-id db-id)
(grant-permissions-for-all-schemas! group-id db-id))
:none
(revoke-schema-and-block-perms! group-id db-id)
;; Groups using connection impersonation for a DB should be treated the same as if they had full self-service
;; data access.
:impersonated
(do
(revoke-schema-and-block-perms! group-id db-id)
(grant-permissions-for-all-schemas! group-id db-id))
;; TODO -- should this code be enterprise only?
:block
(do
(when-not (premium-features/has-feature? :advanced-permissions)
(throw (ee-permissions-exception :block)))
(revoke-data-perms! group-id db-id)
(revoke-download-perms! group-id db-id)
(grant-permissions! group-id (database-block-perms-path db-id)))
(when (map? schemas)
(delete-block-perms-for-db! group-id db-id)
(doseq [schema (keys schemas)]
(update-schema-data-access-permissions! group-id db-id schema (get-in new-db-perms [:schemas schema]))))))) | |
(defn- update-feature-level-permission!
[group-id db-id new-perms perm-type]
(if-let [update-fn (when config/ee-available?
(classloader/require 'metabase-enterprise.advanced-permissions.models.permissions)
(resolve (symbol "metabase-enterprise.advanced-permissions.models.permissions"
(str "update-db-" (name perm-type) "-permissions!"))))]
(update-fn group-id db-id new-perms)
(throw (ee-permissions-exception perm-type)))) | |
(mu/defn ^:private update-group-permissions!
[group-id :- pos-int? new-group-perms :- [:maybe api.permission-graph/StrictDbGraph]]
(doseq [[db-id new-db-perms] new-group-perms
[perm-type new-perms] new-db-perms]
(case perm-type
:data
(update-db-data-access-permissions! group-id db-id new-perms)
:download
(update-feature-level-permission! group-id db-id new-perms :download)
:data-model
(update-feature-level-permission! group-id db-id new-perms :data-model)
:details
(update-feature-level-permission! group-id db-id new-perms :details)))) | |
Set the global execution permission ("/execute/") for the group
with ID | (defn update-global-execution-permission!
[group-id new-perms]
(when-not (or (= group-id (:id (perms-group/all-users)))
(premium-features/has-feature? :advanced-permissions))
(throw (ee-permissions-exception :execute)))
(delete-related-permissions! group-id "/execute/")
(when (= new-perms :all)
(grant-permissions! group-id "/execute/"))) |
(mu/defn ^:private update-execution-permissions!
[group-id :- ms/PositiveInt new-group-perms :- ExecutionGroupPermissionsGraph]
(if (map? new-group-perms)
(doseq [[db-id new-db-perms] new-group-perms]
(update-feature-level-permission! group-id db-id new-db-perms :execute))
(update-global-execution-permission! group-id new-group-perms))) | |
Check that the revision number coming in as part of | (defn check-revision-numbers
[old-graph new-graph]
(when (not= (:revision old-graph) (:revision new-graph))
(throw (ex-info (tru
(str "Looks like someone else edited the permissions and your data is out of date. "
"Please fetch new data and try again."))
{:status-code 409})))) |
Save changes made to permission graph for logging/auditing purposes.
This doesn't do anything if | (defn save-perms-revision!
[model current-revision before changes]
(when *current-user-id*
(first (t2/insert-returning-instances! model
;; manually specify ID here so if one was somehow inserted in the meantime in the fraction of a second since we
;; called `check-revision-numbers` the PK constraint will fail and the transaction will abort
:id (inc current-revision)
:before before
:after changes
:user_id *current-user-id*)))) |
Log changes to the permissions graph. | (defn log-permissions-changes [old new] (log/debug (trs "Changing permissions") "\n" (trs "FROM:") (u/pprint-to-str 'magenta old) "\n" (trs "TO:") (u/pprint-to-str 'blue new))) |
Update the data permissions graph, making any changes necessary to make it match NEW-GRAPH.
This should take in a graph that is exactly the same as the one obtained by Code for updating the Collection permissions graph is in [[metabase.models.collection.graph]]. | (mu/defn update-data-perms-graph!
([new-graph :- api.permission-graph/StrictData]
(let [old-graph (data-perms-graph)
[old new] (data/diff (:groups old-graph) (:groups new-graph))
old (or old {})
new (or new {})]
(when (or (seq old) (seq new))
(log-permissions-changes old new)
(check-revision-numbers old-graph new-graph)
(check-audit-db-permissions new)
(t2/with-transaction [_conn]
(doseq [[group-id changes] new]
(update-group-permissions! group-id changes))
(save-perms-revision! PermissionsRevision (:revision old-graph) old new)
(delete-impersonations-if-needed-after-permissions-change! new)
(delete-gtaps-if-needed-after-permissions-change! new)))))
;; The following arity is provided soley for convenience for tests/REPL usage
([ks :- [:vector :any] new-value]
(update-data-perms-graph! (assoc-in (data-perms-graph) (cons :groups ks) new-value)))) |
Update the execution permissions graph, making any changes necessary to make it match Code for updating the Collection permissions graph is in [[metabase.models.collection.graph]]. | (mu/defn update-execution-perms-graph!
([new-graph :- ExecutionPermissionsGraph]
(let [old-graph (execution-perms-graph)
[old new] (data/diff (:groups old-graph) (:groups new-graph))
old (or old {})]
(when (or (seq old) (seq new))
(log-permissions-changes old new)
(check-revision-numbers old-graph new-graph)
(t2/with-transaction [_conn]
(doseq [[group-id changes] new]
(update-execution-permissions! group-id changes))
(save-perms-revision! PermissionsRevision (:revision old-graph) old new)))))
;; The following arity is provided soley for convenience for tests/REPL usage
([ks :- [:any] new-value]
(update-execution-perms-graph! (assoc-in (execution-perms-graph) (cons :groups ks) new-value)))) |
A A few 'magic' groups exist: [[all-users]], which predicably contains All Users; and [[admin]], which contains all superusers. These groups are 'magic' in the sense that you cannot add users to them yourself, nor can you delete them; they are created automatically. You can, however, set permissions for them. See documentation in [[metabase.models.permissions]] for more information about the Metabase permissions system. | (ns metabase.models.permissions-group (:require [honey.sql.helpers :as sql.helpers] [metabase.db.connection :as mdb.connection] [metabase.db.query :as mdb.query] [metabase.models.interface :as mi] [metabase.models.setting :as setting] [metabase.plugins.classloader :as classloader] [metabase.public-settings.premium-features :as premium-features] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [methodical.core :as methodical] [toucan2.core :as t2])) |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase. | (def PermissionsGroup :model/PermissionsGroup) |
(methodical/defmethod t2/table-name :model/PermissionsGroup [_model] :permissions_group) | |
(derive :model/PermissionsGroup :metabase/model) | |
-------------------------------------------- Magic Groups Getter Fns --------------------------------------------- | |
(defn- magic-group [group-name]
(mdb.connection/memoize-for-application-db
(fn []
(u/prog1 (t2/select-one PermissionsGroup :name group-name)
;; normally it is impossible to delete the magic [[all-users]] or [[admin]] Groups -- see
;; [[check-not-magic-group]]. This assertion is here to catch us if we do something dumb when hacking on
;; the MB code -- to make tests fail fast. For that reason it's not i18n'ed.
(when-not <>
(throw (ex-info (format "Fatal error: magic Permissions Group %s has gone missing." (pr-str group-name))
{:name group-name}))))))) | |
The name of the "All Users" magic group. | (def all-users-group-name "All Users") |
Fetch the | (def ^{:arglists '([])} all-users
(magic-group all-users-group-name)) |
The name of the "Administrators" magic group. | (def admin-group-name "Administrators") |
Fetch the | (def ^{:arglists '([])} admin
(magic-group admin-group-name)) |
--------------------------------------------------- Validation --------------------------------------------------- | |
Does a | (defn exists-with-name?
^Boolean [group-name]
{:pre [((some-fn keyword? string?) group-name)]}
(t2/exists? PermissionsGroup
:%lower.name (u/lower-case-en (name group-name)))) |
(defn- check-name-not-already-taken
[group-name]
(when (exists-with-name? group-name)
(throw (ex-info (tru "A group with that name already exists.") {:status-code 400})))) | |
Make sure we're not trying to edit/delete one of the magic groups, or throw an exception. | (defn- check-not-magic-group
[{id :id}]
{:pre [(integer? id)]}
(doseq [magic-group [(all-users)
(admin)]]
(when (= id (:id magic-group))
(throw (ex-info (tru "You cannot edit or delete the ''{0}'' permissions group!" (:name magic-group))
{:status-code 400}))))) |
--------------------------------------------------- Lifecycle ---------------------------------------------------- | |
(t2/define-before-insert :model/PermissionsGroup
[{group-name :name, :as group}]
(u/prog1 group
(check-name-not-already-taken group-name))) | |
(t2/define-before-delete :model/PermissionsGroup
[{id :id, :as group}]
(check-not-magic-group group)
;; Remove from LDAP mappings
(classloader/require 'metabase.integrations.ldap)
(setting/set-value-of-type!
:json :ldap-group-mappings
(when-let [mappings (setting/get-value-of-type :json :ldap-group-mappings)]
(zipmap (keys mappings)
(for [val (vals mappings)]
(remove (partial = id) val)))))) | |
(t2/define-before-update :model/PermissionsGroup
[group]
(let [changes (t2/changes group)]
(u/prog1 group
(check-not-magic-group group)
(when-let [group-name (:name changes)]
(check-name-not-already-taken group-name))))) | |
---------------------------------------------------- Util Fns ---------------------------------------------------- | |
(mi/define-simple-hydration-method members
:members
"Return `Users` that belong to `group-or-id`, ordered by their name (case-insensitive)."
[group-or-id]
(mdb.query/query (cond-> {:select [:user.first_name
:user.last_name
:user.email
[:user.id :user_id]
[:pgm.id :membership_id]]
:from [[:core_user :user]]
:left-join [[:permissions_group_membership :pgm] [:= :user.id :pgm.user_id]]
:where [:and [:= :user.is_active true]
[:= :pgm.group_id (u/the-id group-or-id)]]
:order-by [[[:lower :user.first_name] :asc]
[[:lower :user.last_name] :asc]]}
(premium-features/enable-advanced-permissions?)
(sql.helpers/select [:pgm.is_group_manager :is_group_manager])))) | |
Return a set of the IDs of all | (defn non-admin-groups [] (t2/select PermissionsGroup :name [:not= admin-group-name])) |
(ns metabase.models.permissions-group-membership (:require [metabase.db.query :as mdb.query] [metabase.models.permissions-group :as perms-group] [metabase.util :as u] [metabase.util.i18n :refer [deferred-tru tru]] [methodical.core :as methodical] [toucan2.core :as t2])) | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase. | (def PermissionsGroupMembership :model/PermissionsGroupMembership) |
(methodical/defmethod t2/table-name :model/PermissionsGroupMembership [_model] :permissions_group_membership) | |
(derive :model/PermissionsGroupMembership :metabase/model) | |
Exception message when try to remove the last admin. | (def fail-to-remove-last-admin-msg (deferred-tru "You cannot remove the last member of the ''Admin'' group!")) |
Should we allow people to be added to or removed from the All Users permissions group? By
default, this is | (defonce ^:dynamic *allow-changing-all-users-group-members* false) |
Throw an Exception if we're trying to add or remove a user to the All Users group. | (defn- check-not-all-users-group
[group-id]
(when (= group-id (:id (perms-group/all-users)))
(when-not *allow-changing-all-users-group-members*
(throw (ex-info (tru "You cannot add or remove users to/from the ''All Users'' group.")
{:status-code 400}))))) |
The current number of non-archived admins (superusers). | (defn- admin-count
[]
(:count
(first
(mdb.query/query {:select [[:%count.* :count]]
:from [[:permissions_group_membership :pgm]]
:join [[:core_user :user] [:= :user.id :pgm.user_id]]
:where [:and
[:= :pgm.group_id (u/the-id (perms-group/admin))]
[:= :user.is_active true]]})))) |
Throw an Exception if there is only one admin (superuser) left. The assumption is that the one admin is about to be archived or have their admin status removed. | (defn throw-if-last-admin!
[]
(when (<= (admin-count) 1)
(throw (ex-info (str fail-to-remove-last-admin-msg)
{:status-code 400})))) |
(t2/define-before-delete :model/PermissionsGroupMembership
[{:keys [group_id user_id]}]
(check-not-all-users-group group_id)
;; Otherwise if this is the Admin group...
(when (= group_id (:id (perms-group/admin)))
;; ...and this is the last membership, throw an exception
(throw-if-last-admin!)
;; ...otherwise we're ok. Unset the `:is_superuser` flag for the user whose membership was revoked
(t2/update! 'User user_id {:is_superuser false}))) | |
(t2/define-before-insert :model/PermissionsGroupMembership
[{:keys [group_id], :as membership}]
(u/prog1 membership
(check-not-all-users-group group_id))) | |
(t2/define-after-insert :model/PermissionsGroupMembership
[{:keys [group_id user_id], :as membership}]
(u/prog1 membership
;; If we're adding a user to the admin group, set the `:is_superuser` flag for the user to whom membership was
;; granted
(when (= group_id (:id (perms-group/admin)))
(t2/update! :core_user user_id {:is_superuser true})))) | |
(ns metabase.models.permissions-revision (:require [metabase.models.interface :as mi] [metabase.util.i18n :refer [tru]] [methodical.core :as methodical] [toucan2.core :as t2])) | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase. | (def PermissionsRevision :model/PermissionsRevision) |
(methodical/defmethod t2/table-name :model/PermissionsRevision [_model] :permissions_revision) | |
(doto :model/PermissionsRevision (derive :metabase/model) (derive :hook/created-at-timestamped?)) | |
(t2/deftransforms :model/PermissionsRevision
{:before mi/transform-json
:after mi/transform-json}) | |
(t2/define-before-update :model/PermissionsRevision [_] (throw (Exception. (tru "You cannot update a PermissionsRevision!")))) | |
Return the ID of the newest | (defn latest-id
[]
(or (t2/select-one-pk PermissionsRevision {:order-by [[:id :desc]]})
0)) |
Parses sets of permissions to create a permission graph. Strategy is:
| (ns metabase.models.permissions.parse (:require [clojure.core.match :refer [match]] [clojure.string :as str] [clojure.walk :as walk] [instaparse.core :as insta] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log])) |
(set! *warn-on-reflection* true) | |
Describes permission strings like /db/3/ or /collection/root/read/ | (def ^:private grammar
"permission = ( all | execute | db | block | download | data-model | details | collection | data-v2 | query-v2)
all = <'/'>
data-v2 = <'/data/db/'> #'\\d+' <'/'> ( native | execute | schemas )?
query-v2 = <'/query/db/'> #'\\d+' <'/'> ( native | execute | schemas )?
db = <'/db/'> #'\\d+' <'/'> ( native | execute | schemas )?
execute = <'/execute/'> ( <'db/'> #'\\d+' <'/'> )?
native = <'native/'>
schemas = <'schema/'> schema?
schema = schema-name <'/'> table?
table = <'table/'> #'\\d+' <'/'> (table-perm <'/'>)?
table-perm = ('read'|'query'|'query/segmented')
block = <'/block/db/'> #'\\d+' <'/'>
download = <'/download'> ( dl-limited | dl-db)
dl-limited = <'/limited'> dl-db
dl-db = <'/db/'> #'\\d+' <'/'> ( dl-native | dl-schemas )?
dl-native = <'native/'>
dl-schemas = <'schema/'> dl-schema?
dl-schema = schema-name <'/'> dl-table?
dl-table = <'table/'> #'\\d+' <'/'>
data-model = <'/data-model'> dm-db
dm-db = <'/db/'> #'\\d+' <'/'> dm-schema?
dm-schema = <'schema/'> schema-name <'/'> dm-table?
dm-table = <'table/'> #'\\d+' <'/'>
details = <'/details'> <'/db/'> #'\\d+' <'/'>
schema-name = #'(\\\\/|[^/])*' (* schema name can have \\/ but not /*)
collection = <'/collection/'> #'[^/]*' <'/'> ('read' <'/'>)?") |
Function that parses permission strings | (def ^:private ^{:arglists '([s])} parser
(insta/parser grammar)) |
(defn- collection-id [id] (if (= id "root") :root (Long/parseUnsignedLong id))) | |
Unescape slashes for things that has been escaped before storing in DB (e.g: DB schema name). To find things that were being escaped: check references of [[metabase.models.permissions/escape-path-component]]. (unescape-path-component "a\/b" => "a/b"). | (defn- unescape-path-component
"Unescape slashes for things that has been escaped before storing in DB (e.g: DB schema name).
To find things that were being escaped: check references of [[metabase.models.permissions/escape-path-component]].
(unescape-path-component \"a\\/b\" => \"a/b\")."
[s]
(some-> s
(str/replace "\\/" "/") ; \/ -> /
(str/replace "\\\\" "\\"))) ; \\ -> \ |
If | (defn- append-to-all
[path-or-paths x]
(if (seqable? (first path-or-paths))
(map (fn [path] (append-to-all path x)) (seq path-or-paths))
(into path-or-paths [x]))) |
(defn- path1
[tree]
(match tree
[:permission t] (path1 t)
[:schema-name schema-name] (unescape-path-component schema-name)
[:all] [:all] ; admin permissions
[:db db-id] (let [db-id (Long/parseUnsignedLong db-id)] [[:db db-id :data :native :write] [:db db-id :data :schemas :all]])
[:db db-id db-node] (into [:db (Long/parseUnsignedLong db-id) :data] (path1 db-node))
[:data-v2 db-id] (let [db-id (Long/parseUnsignedLong db-id)] [[:db db-id :data :native :write]])
[:data-v2 db-id db-node] (into [:db (Long/parseUnsignedLong db-id) :data] (path1 db-node))
[:query-v2 db-id] (let [db-id (Long/parseUnsignedLong db-id)] [[:db db-id :query :native :write] [:db db-id :query :schemas :all]])
[:query-v2 db-id db-node] (into [:db (Long/parseUnsignedLong db-id) :query] (path1 db-node))
[:schemas] [:schemas :all]
[:schemas schema] (into [:schemas] (path1 schema))
[:schema schema-name] [(path1 schema-name) :all]
[:schema schema-name table] (into [(path1 schema-name)] (path1 table))
[:table table-id] [(Long/parseUnsignedLong table-id) :all]
[:table table-id table-perm] (into [(Long/parseUnsignedLong table-id)] (path1 table-perm))
[:table-perm perm] (case perm
"read" [:read :all]
"query" [:query :all]
"query/segmented" [:query :segmented])
[:native] [:native :write]
;; block perms. Parse something like /block/db/1/ to {:db {1 {:schemas :block}}}
[:block db-id] [:db (Long/parseUnsignedLong db-id) :data :schemas :block]
;; download perms
[:download
[:dl-limited db-node]] (append-to-all (path1 db-node) :limited)
[:download db-node] (append-to-all (path1 db-node) :full)
[:dl-db db-id] (let [db-id (Long/parseUnsignedLong db-id)]
#{[:db db-id :download :native]
[:db db-id :download :schemas]})
[:dl-db db-id db-node] (let [db-id (Long/parseUnsignedLong db-id)]
(into [:db db-id] (path1 db-node)))
[:dl-schemas] [:download :schemas]
[:dl-schemas schema] (into [:download :schemas] (path1 schema))
[:dl-schema schema-name] [(path1 schema-name)]
[:dl-schema schema-name table] (into [(path1 schema-name)] (path1 table))
[:dl-table table-id] [(Long/parseUnsignedLong table-id)]
[:dl-native] [:download :native]
;; collection perms
[:collection id] [:collection (collection-id id) :write]
[:collection id "read"] [:collection (collection-id id) :read]
;; return nil if the tree could not be parsed, so that we can try calling `path2` instead
:else nil)) | |
(defn- path2
[tree]
(match tree
(_ :guard insta/failure?) (log/error (trs "Error parsing permissions tree {0}" (pr-str tree)))
[:permission t] (path2 t)
[:execute] [:execute :all]
[:execute db-id] [:execute (Long/parseUnsignedLong db-id) :all]
[:schema-name schema-name] (unescape-path-component schema-name)
;; data model perms
[:data-model db-node] (path2 db-node)
[:dm-db db-id] (let [db-id (Long/parseUnsignedLong db-id)]
[:db db-id :data-model :schemas :all])
[:dm-db db-id db-node] (let [db-id (Long/parseUnsignedLong db-id)]
(into [:db db-id :data-model :schemas] (path2 db-node)))
[:dm-schema schema-name] [(path2 schema-name) :all]
[:dm-schema schema-name table] (into [(path2 schema-name)] (path2 table))
[:dm-table table-id] [(Long/parseUnsignedLong table-id) :all]
;; DB details perms
[:details db-id] (let [db-id (Long/parseUnsignedLong db-id)]
[:db db-id :details :yes]))) | |
Recursively build permission path from parse tree. Implementation must be split between two pattern matching functions, because having all the clauses in a single pattern match will cause a compilation error due to CLJ-1852 | (defn- path [tree] (or (path1 tree) (path2 tree))) |
Given a set of permission paths, return a graph that expresses the most permissions possible for the set Works by first doing a conversion like [[3 :schemas :all] [3 :schemas "PUBLIC" :all] -> {3 {:schemas {:all () :public {:all ()}}}} Then converting that to {3 {:schemas :all}} | (defn- graph
[paths]
(->> paths
(reduce (fn [paths path]
(if (every? vector? path) ;; handle case where /db/x/ returns two vectors
(into paths path)
(conj paths path)))
[])
(walk/prewalk (fn [x]
(if (and (sequential? x) (sequential? (first x)) (seq (first x)))
(->> x
(group-by first)
(reduce-kv (fn [m k v]
(assoc m k (->> (map rest v) (filter seq))))
{}))
x)))
(walk/prewalk (fn [x]
(or (when (map? x)
(some #(and (= (% x) '()) %)
[:block :all :some :write :read :segmented :full :limited :yes]))
x))))) |
Given a set of permission strings, return a graph that expresses the most permissions possible for the set | (defn ->graph
[permissions]
(->> permissions
(map (comp path parser))
graph)) |
(ns metabase.models.persisted-info (:require [buddy.core.codecs :as codecs] [clojure.string :as str] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.models.interface :as mi] [metabase.public-settings.premium-features :as premium-features :refer [defenterprise]] [metabase.query-processor.util :as qp.util] [metabase.util :as u] [metabase.util.malli :as mu] [methodical.core :as methodical] [toucan2.core :as t2])) | |
----------------------------------------------- Entity & Lifecycle ----------------------------------------------- | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the Card symbol in our codebase. | (def PersistedInfo :model/PersistedInfo) |
(methodical/defmethod t2/table-name :model/PersistedInfo [_model] :persisted_info) | |
(derive :model/PersistedInfo :metabase/model) | |
Parse the value of | (defn transform-definition-out
[definition]
(when-let [definition (not-empty (mi/json-out-with-keywordization definition))]
(update definition :field-definitions (fn [field-definitions]
(mapv #(update % :base-type keyword)
field-definitions))))) |
(t2/deftransforms :model/PersistedInfo
{:definition {:in mi/json-in
:out transform-definition-out}}) | |
Map containing the type and name of fields for dll. The type is :base-type and uses the effectivetype else basetype of a field. | (defn- field-metadata->field-defintion
[{field-name :name :keys [base_type effective_type]}]
{:field-name field-name
:base-type (or effective_type base_type)}) |
Spec for metadata. Just asserting we have base types and names, not the full metadata of the qp. | (def ^:private Metadata
[:maybe
[:sequential
[:map
[:name :string]
[:base_type ::lib.schema.common/base-type]
[:effective_type {:optional true} ::lib.schema.common/base-type]]]]) |
(mu/defn metadata->definition :- ::lib.schema.metadata/persisted-info.definition
"Returns a ddl definition datastructure. A :table-name and :field-deifinitions vector of field-name and base-type."
[metadata :- Metadata table-name]
{:table-name table-name
:field-definitions (mapv field-metadata->field-defintion metadata)}) | |
Base64 string of the hash of a query. | (mu/defn query-hash [query :- :map] (String. ^bytes (codecs/bytes->b64 (qp.util/query-hash query)))) |
Allow persisted substitution. When refreshing, set this to nil to ensure that all underlying queries are used to rebuild the persisted table. | (def ^:dynamic *allow-persisted-substitution* true) |
A slug from a card suitable for a table name. This slug is not intended to be unique but to be human guide if looking
at schemas. Persisted table names will follow the pattern | (defn- slug-name
[nom]
(->> (str/replace (u/lower-case-en nom) #"\s+" "_")
(take 10)
(apply str))) |
States of 'off' needs to be handled here even though setting the state to off is only possible with :cache-granular-controls enabled. A model could still have state=off if the instance previously had the feature flag, then downgraded to not have it. In that case models with state=off were previously prunable when the feature flag enabled, but they should be refreshable with the feature flag disabled. | (defenterprise refreshable-states
metabase-enterprise.advanced-config.caching
[]
#{"creating" "persisted" "error" "off"}) |
States of | (defenterprise prunable-states
metabase-enterprise.advanced-config.caching
[]
#{"deletable"}) |
(mi/define-batched-hydration-method persisted?
:persisted
"Hydrate a card :is_persisted for the frontend."
[cards]
(when (seq cards)
(let [existing-ids (t2/select-fn-set :card_id PersistedInfo
:card_id [:in (map :id cards)]
:state [:in (refreshable-states)])]
(map (fn [{id :id :as card}]
(assoc card :persisted (contains? existing-ids id)))
cards)))) | |
Marks PersistedInfo as | (defn mark-for-pruning!
([conditions-map]
(mark-for-pruning! conditions-map "deletable"))
([conditions-map state]
(t2/update! PersistedInfo conditions-map {:active false, :state state, :state_change_at :%now}))) |
Marks PersistedInfo as | (defn- create-row
[user-id card]
(let [slug (-> card :name slug-name)
{:keys [database_id]} card
card-id (u/the-id card)]
{:card_id card-id
:database_id database_id
:question_slug slug
:table_name (format "model_%s_%s" card-id slug)
:active false
:refresh_begin :%now
:refresh_end nil
:state "creating"
:state_change_at :%now
:creator_id user-id})) |
Looks for all new models in database and creates a persisted-info ready to be synced. | (defn ready-unpersisted-models!
[database-id]
(let [cards (t2/select :model/Card
{:where [:and
[:= :database_id database-id]
[:= :dataset true]
[:not [:exists {:select [1]
:from [:persisted_info]
:where [:= :persisted_info.card_id :report_card.id]}]]]})]
(t2/insert! PersistedInfo (map #(create-row nil %) cards)))) |
Marks PersistedInfo as | (defn turn-on-model!
[user-id card]
(let [card-id (u/the-id card)
existing-persisted-info (t2/select-one PersistedInfo :card_id card-id)
persisted-info (cond
(not existing-persisted-info)
(first (t2/insert-returning-instances! PersistedInfo (create-row user-id card)))
(contains? #{"deletable" "off"} (:state existing-persisted-info))
(do
(t2/update! PersistedInfo (u/the-id existing-persisted-info)
{:active false, :state "creating", :state_change_at :%now})
(t2/select-one PersistedInfo :card_id card-id)))]
persisted-info)) |
Sets PersistedInfo state to | (defn ready-database!
[database-id]
(t2/query-one
{:update [:persisted_info]
:where [:and
[:= :database_id database-id]
[:= :state "deletable"]]
:set {:active false,
:state "creating",
:state_change_at :%now}})
(ready-unpersisted-models! database-id)) |
Notifications are ways to deliver the results of Questions to users without going through the normal Metabase UI. At the time of this writing, there are two delivery mechanisms for Notifications -- email and Slack notifications; these destinations are known as 'Channels'. Notifications themselves are further divided into two categories -- 'Pulses', which are sent at specified intervals, and 'Alerts', which are sent when certain conditions are met (such as a query returning results). Because 'Pulses' were originally the only type of Notification, this name is still used for the model itself, and in some of the functions below. To keep things clear, try to make sure you use the term 'Notification' for things that work with either type. One more thing to keep in mind: this code is pretty old and doesn't follow the code patterns used in the other Metabase models. There is a plethora of CRUD functions for working with Pulses that IMO aren't really needed (e.g. functions for fetching a specific Pulse). At some point in the future, we can clean this namespace up and bring the code in line with the rest of the codebase, but for the time being, it probably makes sense to follow the existing patterns in this namespace rather than further confuse things. Legacy note: Currently Pulses are associated with a dashboard, but this is not always the case since there are legacy pulses that are a collection of cards, not dashboard. | (ns metabase.models.pulse (:require [clojure.string :as str] [malli.core :as mc] [medley.core :as m] [metabase.api.common :as api] [metabase.events :as events] [metabase.models.collection :as collection] [metabase.models.interface :as mi] [metabase.models.permissions :as perms] [metabase.models.pulse-card :refer [PulseCard]] [metabase.models.pulse-channel :as pulse-channel :refer [PulseChannel]] [metabase.models.serialization :as serdes] [metabase.util :as u] [metabase.util.i18n :refer [deferred-tru tru]] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [methodical.core :as methodical] [toucan2.core :as t2])) |
----------------------------------------------- Entity & Lifecycle ----------------------------------------------- | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase. | (def Pulse :model/Pulse) |
(methodical/defmethod t2/table-name :model/Pulse [_model] :pulse) (methodical/defmethod t2/model-for-automagic-hydration [:default :pulse] [_original-model _k] :model/Pulse) | |
(doto :model/Pulse (derive :metabase/model) (derive :hook/timestamped?) (derive :hook/entity-id) (derive ::mi/read-policy.full-perms-for-perms-set)) | |
(t2/deftransforms :model/Pulse
{:parameters mi/transform-json}) | |
(defn- assert-valid-parameters [{:keys [parameters]}]
(when-not (mc/validate [:maybe
[:sequential
[:and
[:map [:id ms/NonBlankString]]
[:map-of :keyword :any]]]]
parameters)
(throw (ex-info (tru ":parameters must be a sequence of maps with String :id keys")
{:parameters parameters})))) | |
(t2/define-before-insert :model/Pulse
[notification]
(let [defaults {:parameters []}
dashboard-id (:dashboard_id notification)
collection-id (if dashboard-id
(t2/select-one-fn :collection_id 'Dashboard, :id dashboard-id)
(:collection_id notification))
notification (->> (for [[k v] notification
:when (some? v)]
{k v})
(apply merge defaults {:collection_id collection-id}))]
(u/prog1 notification
(assert-valid-parameters notification)
(collection/check-collection-namespace Pulse (:collection_id notification))))) | |
If true, allows the collection_id on a dashboard subscription to be modified. This should only be done when the associated dashboard is being moved to a new collection. | (def ^:dynamic *allow-moving-dashboard-subscriptions* false) |
(t2/define-before-update :model/Pulse
[notification]
(let [{:keys [collection_id dashboard_id]} (t2/original notification)]
(when (and dashboard_id
(contains? notification :collection_id)
(not= (:collection_id notification) collection_id)
(not *allow-moving-dashboard-subscriptions*))
(throw (ex-info (tru "collection ID of a dashboard subscription cannot be directly modified") notification)))
(when (and dashboard_id
(contains? notification :dashboard_id)
(not= (:dashboard_id notification) dashboard_id))
(throw (ex-info (tru "dashboard ID of a dashboard subscription cannot be modified") notification))))
(u/prog1 (t2/changes notification)
(assert-valid-parameters notification)
(collection/check-collection-namespace Pulse (:collection_id notification)))) | |
Return the Card associated with an Alert, fetching it if needed, for permissions-checking purposes. | (defn- alert->card [alert] (or ;; if `card` is already present as a top-level key we can just use that directly (:card alert) ;; otherwise fetch the associated `:cards` (if not already fetched) and then pull the first one out, since Alerts ;; can only have one Card (-> (t2/hydrate alert :cards) :cards first) ;; if there's still not a Card, throw an Exception! (throw (Exception. (tru "Invalid Alert: Alert does not have a Card associated with it"))))) |
Whether | (defn is-alert? [notification] (boolean (:alert_condition notification))) |
Permissions to read or write an Alert are the same as those of its 'parent' Card. For all intents and purposes, an Alert cannot be put into a Collection. Permissions to read a Dashboard Subscription are more complex. A non-admin can read a Dashboard Subscription if
they have read access to its parent Collection, and they are a creator or recipient of the subscription. A
non-admin can write a Dashboard Subscription only if they are its creator. (Admins have full read and write
permissions for all objects.) These checks are handled by the | |
(defmethod mi/perms-objects-set Pulse
[notification read-or-write]
(if (is-alert? notification)
(mi/perms-objects-set (alert->card notification) read-or-write)
(perms/perms-objects-set-for-parent-collection notification read-or-write))) | |
(defn- current-user-is-creator? [notification] (= api/*current-user-id* (:creator_id notification))) | |
(defn- current-user-is-recipient?
[notification]
(let [channels (:channels (t2/hydrate notification [:channels :recipients]))
recipient-ids (for [{recipients :recipients} channels
recipient recipients]
(:id recipient))]
(boolean
(some #{api/*current-user-id*} recipient-ids)))) | |
(defmethod mi/can-read? Pulse
[notification]
(if (is-alert? notification)
(mi/current-user-has-full-permissions? :read notification)
(or api/*is-superuser?*
(or (current-user-is-creator? notification)
(current-user-is-recipient? notification))))) | |
Non-admins should be able to create subscriptions, and update subscriptions that they created, but not edit anyone else's subscriptions (except for unsubscribing themselves, which uses a custom API). | (defmethod mi/can-write? Pulse
[notification]
(if (is-alert? notification)
(mi/current-user-has-full-permissions? :write notification)
(or api/*is-superuser?*
(and (mi/current-user-has-full-permissions? :read notification)
(current-user-is-creator? notification))))) |
(defmethod serdes/hash-fields Pulse [_pulse] [:name (serdes/hydrated-hash :collection) :created_at]) | |
---------------------------------------------------- Schemas ----------------------------------------------------- | |
Schema for valid values of | (def AlertConditions [:enum "rows" "goal"]) |
Schema for the map we use to internally represent the fact that a Card is in a Notification and the details about its presence there. | (def CardRef
(mu/with-api-error-message
[:map
[:id ms/PositiveInt]
[:include_csv ms/BooleanValue]
[:include_xls ms/BooleanValue]
[:dashboard_card_id {:optional true} [:maybe ms/PositiveInt]]]
(deferred-tru "value must be a map with the keys `{0}`, `{1}`, `{2}`, and `{3}`." "id" "include_csv" "include_xls" "dashboard_card_id"))) |
This schema represents the cards that are included in a pulse. This is the data from the | (def HybridPulseCard
(mu/with-api-error-message
[:merge CardRef
[:map
[:name [:maybe string?]]
[:description [:maybe string?]]
[:display [:maybe ms/KeywordOrString]]
[:collection_id [:maybe ms/PositiveInt]]
[:dashboard_id [:maybe ms/PositiveInt]]
[:parameter_mappings [:maybe [:sequential ms/Map]]]]]
(deferred-tru "value must be a map with the following keys `({0})`"
(str/join ", " ["collection_id" "description" "display" "id" "include_csv" "include_xls" "name"
"dashboard_id" "parameter_mappings"])))) |
Schema for functions accepting either a | (def CoercibleToCardRef [:or HybridPulseCard CardRef]) |
--------------------------------------------------- Hydration ---------------------------------------------------- | |
(mi/define-simple-hydration-method channels :channels "Return the PulseChannels associated with this `notification`." [notification-or-id] (t2/select PulseChannel, :pulse_id (u/the-id notification-or-id))) | |
By default the :cards hydration method only return active cards, but in cases we need to send email after a card is archived, we need to be able to hydrate archived card as well. | (def ^:dynamic *allow-hydrate-archived-cards* false) |
(mu/defn ^:private cards* :- [:sequential HybridPulseCard]
[notification-or-id]
(t2/select
:model/Card
{:select [:c.id :c.name :c.description :c.collection_id :c.display :pc.include_csv :pc.include_xls
:pc.dashboard_card_id :dc.dashboard_id [nil :parameter_mappings]] ;; :dc.parameter_mappings - how do you select this?
:from [[:pulse :p]]
:join [[:pulse_card :pc] [:= :p.id :pc.pulse_id]
[:report_card :c] [:= :c.id :pc.card_id]]
:left-join [[:report_dashboardcard :dc] [:= :pc.dashboard_card_id :dc.id]]
:where [:and
[:= :p.id (u/the-id notification-or-id)]
(when-not *allow-hydrate-archived-cards*
[:= :c.archived false])]
:order-by [[:pc.position :asc]]})) | |
(mi/define-simple-hydration-method cards :cards "Return the Cards associated with this `notification`." [notification-or-id] (cards* notification-or-id)) | |
---------------------------------------- Notification Fetching Helper Fns ---------------------------------------- | |
(mu/defn hydrate-notification :- (mi/InstanceOf Pulse)
"Hydrate Pulse or Alert with the Fields needed for sending it."
[notification :- (mi/InstanceOf Pulse)]
(-> notification
(t2/hydrate :creator :cards [:channels :recipients])
(m/dissoc-in [:details :emails]))) | |
(mu/defn ^:private hydrate-notifications :- [:sequential (mi/InstanceOf Pulse)]
"Batched-hydrate multiple Pulses or Alerts."
[notifications :- [:sequential (mi/InstanceOf Pulse)]]
(as-> notifications <>
(t2/hydrate <> :creator :cards [:channels :recipients])
(map #(m/dissoc-in % [:details :emails]) <>))) | |
(mu/defn ^:private notification->pulse :- (mi/InstanceOf Pulse) "Take a generic `Notification`, and put it in the standard Pulse format the frontend expects. This really just consists of removing associated `Alert` columns." [notification :- (mi/InstanceOf Pulse)] (dissoc notification :alert_condition :alert_above_goal :alert_first_only)) | |
TODO - do we really need this function? Why can't we just use | (mu/defn retrieve-pulse :- [:maybe (mi/InstanceOf Pulse)]
"Fetch a single *Pulse*, and hydrate it with a set of 'standard' hydrations; remove Alert columns, since this is a
*Pulse* and they will all be unset."
[pulse-or-id]
(some-> (t2/select-one Pulse :id (u/the-id pulse-or-id), :alert_condition nil)
hydrate-notification
notification->pulse)) |
(mu/defn retrieve-notification :- [:maybe (mi/InstanceOf Pulse)]
"Fetch an Alert or Pulse, and do the 'standard' hydrations, adding `:channels` with `:recipients`, `:creator`, and
`:cards`."
[notification-or-id & additional-conditions]
{:pre [(even? (count additional-conditions))]}
(some-> (apply t2/select-one Pulse :id (u/the-id notification-or-id), additional-conditions)
hydrate-notification)) | |
(mu/defn ^:private notification->alert :- (mi/InstanceOf Pulse)
"Take a generic `Notification` and put it in the standard `Alert` format the frontend expects. This really just
consists of collapsing `:cards` into a `:card` key with whatever the first Card is."
[notification :- (mi/InstanceOf Pulse)]
(-> notification
(assoc :card (first (:cards notification)))
(dissoc :cards))) | |
(mu/defn retrieve-alert :- [:maybe (mi/InstanceOf Pulse)]
"Fetch a single Alert by its `id` value, do the standard hydrations, and put it in the standard `Alert` format."
[alert-or-id]
(some-> (t2/select-one Pulse, :id (u/the-id alert-or-id), :alert_condition [:not= nil])
hydrate-notification
notification->alert)) | |
(defn- query-as [model query] (t2/select model query)) | |
(mu/defn retrieve-alerts :- [:sequential (mi/InstanceOf Pulse)]
"Fetch all Alerts."
([]
(retrieve-alerts nil))
([{:keys [archived? user-id]
:or {archived? false}}]
(assert boolean? archived?)
(let [query (merge {:select-distinct [:p.* [[:lower :p.name] :lower-name]]
:from [[:pulse :p]]
:where [:and
[:not= :p.alert_condition nil]
[:= :p.archived archived?]
(when user-id
[:or
[:= :p.creator_id user-id]
[:= :pcr.user_id user-id]])]
:order-by [[:lower-name :asc]]}
(when user-id
{:left-join [[:pulse_channel :pchan] [:= :p.id :pchan.pulse_id]
[:pulse_channel_recipient :pcr] [:= :pchan.id :pcr.pulse_channel_id]]}))]
(for [alert (hydrate-notifications (query-as Pulse query))
:let [alert (notification->alert alert)]
;; if for whatever reason the Alert doesn't have a Card associated with it (e.g. the Card was deleted) don't
;; return the Alert -- it's basically orphaned/invalid at this point. See #13575 -- we *should* be deleting
;; Alerts if their associated PulseCard is deleted, but that's not currently the case.
:when (:card alert)]
alert)))) | |
(mu/defn retrieve-pulses :- [:sequential (mi/InstanceOf Pulse)]
"Fetch all `Pulses`. When `user-id` is included, only fetches `Pulses` for which the provided user is the creator
or a recipient."
[{:keys [archived? dashboard-id user-id]
:or {archived? false}}]
(let [query {:select-distinct [:p.* [[:lower :p.name] :lower-name]]
:from [[:pulse :p]]
:left-join (concat
[[:report_dashboard :d] [:= :p.dashboard_id :d.id]]
(when user-id
[[:pulse_channel :pchan] [:= :p.id :pchan.pulse_id]
[:pulse_channel_recipient :pcr] [:= :pchan.id :pcr.pulse_channel_id]]))
:where [:and
[:= :p.alert_condition nil]
[:= :p.archived archived?]
;; Only return dashboard subscriptions for non-archived dashboards
[:or
[:= :p.dashboard_id nil]
[:= :d.archived false]]
(when dashboard-id
[:= :p.dashboard_id dashboard-id])
;; Only return dashboard subscriptions when `user-id` is passed, so that legacy
;; pulses don't show up in the notification management page
(when user-id
[:and
[:not= :p.dashboard_id nil]
[:or
[:= :p.creator_id user-id]
[:= :pcr.user_id user-id]]])]
:order-by [[:lower-name :asc]]}]
(for [pulse (query-as Pulse query)]
(-> pulse
(dissoc :lower-name)
hydrate-notification
notification->pulse)))) | |
Find all alerts for | (defn retrieve-user-alerts-for-card
[{:keys [archived? card-id user-id]
:or {archived? false}}]
(assert boolean? archived?)
(map (comp notification->alert hydrate-notification)
(query-as Pulse
{:select [:p.*]
:from [[:pulse :p]]
:join [[:pulse_card :pc] [:= :p.id :pc.pulse_id]
[:pulse_channel :pchan] [:= :pchan.pulse_id :p.id]
[:pulse_channel_recipient :pcr] [:= :pchan.id :pcr.pulse_channel_id]]
:where [:and
[:not= :p.alert_condition nil]
[:= :pc.card_id card-id]
[:= :pcr.user_id user-id]
[:= :p.archived archived?]]}))) |
Find all alerts for | (defn retrieve-alerts-for-cards
[{:keys [archived? card-ids]
:or {archived? false}}]
(when (seq card-ids)
(map (comp notification->alert hydrate-notification)
(query-as Pulse
{:select [:p.*]
:from [[:pulse :p]]
:join [[:pulse_card :pc] [:= :p.id :pc.pulse_id]]
:where [:and
[:not= :p.alert_condition nil]
[:in :pc.card_id card-ids]
[:= :p.archived archived?]]})))) |
(mu/defn card->ref :- CardRef
"Create a card reference from a card or id"
[card :- :map]
{:id (u/the-id card)
:include_csv (get card :include_csv false)
:include_xls (get card :include_xls false)
:dashboard_card_id (get card :dashboard_card_id nil)}) | |
------------------------------------------ Other Persistence Functions ------------------------------------------- | |
Update the PulseCards for a given
| (mu/defn update-notification-cards!
[notification-or-id card-refs :- [:maybe [:sequential CardRef]]]
;; first off, just delete any cards associated with this pulse (we add them again below)
(t2/delete! PulseCard :pulse_id (u/the-id notification-or-id))
;; now just insert all of the cards that were given to us
(when (seq card-refs)
(let [cards (map-indexed (fn [i {card-id :id :keys [include_csv include_xls dashboard_card_id]}]
{:pulse_id (u/the-id notification-or-id)
:card_id card-id
:position i
:include_csv include_csv
:include_xls include_xls
:dashboard_card_id dashboard_card_id})
card-refs)]
(t2/insert! PulseCard cards)))) |
Utility function used by [[update-notification-channels!]] which determines how to properly update a single pulse channel. | (defn- create-update-delete-channel!
[notification-or-id new-channel existing-channel]
;; NOTE that we force the :id of the channel being updated to the :id we *know* from our
;; existing list of PulseChannels pulled from the db to ensure we affect the right record
(let [channel (when new-channel
(assoc new-channel
:pulse_id (u/the-id notification-or-id)
:id (:id existing-channel)
:enabled (:enabled new-channel)
:channel_type (keyword (:channel_type new-channel))
:schedule_type (keyword (:schedule_type new-channel))
:schedule_frame (keyword (:schedule_frame new-channel))))]
(cond
;; 1. in channels, NOT in db-channels = CREATE
(and channel (not existing-channel)) (pulse-channel/create-pulse-channel! channel)
;; 2. NOT in channels, in db-channels = DELETE
(and (nil? channel) existing-channel) (t2/delete! PulseChannel :id (:id existing-channel))
;; 3. in channels, in db-channels = UPDATE
(and channel existing-channel) (pulse-channel/update-pulse-channel! channel)
;; 4. NOT in channels, NOT in db-channels = NO-OP
:else nil))) |
Update the PulseChannels for a given
| (mu/defn update-notification-channels!
[notification-or-id channels :- [:sequential :map]]
(let [new-channels (group-by (comp keyword :channel_type) channels)
old-channels (group-by (comp keyword :channel_type) (t2/select PulseChannel
:pulse_id (u/the-id notification-or-id)))
handle-channel #(create-update-delete-channel! (u/the-id notification-or-id)
(first (get new-channels %))
(first (get old-channels %)))]
(assert (zero? (count (get new-channels nil)))
"Cannot have channels without a :channel_type attribute")
;; don't automatically archive this Pulse if we end up deleting its last PulseChannel -- we're probably replacing
;; it with a new one immediately thereafter.
(binding [pulse-channel/*archive-parent-pulse-when-last-channel-is-deleted* false]
;; for each of our possible channel types call our handler function
(doseq [[channel-type] pulse-channel/channel-types]
(handle-channel channel-type))))) |
Create a new Pulse/Alert with the properties specified in | (mu/defn ^:private create-notification-and-add-cards-and-channels!
[notification card-refs :- [:maybe [:sequential CardRef]] channels]
(t2/with-transaction [_conn]
(let [notification (first (t2/insert-returning-instances! Pulse notification))]
(update-notification-cards! notification card-refs)
(update-notification-channels! notification channels)
(u/the-id notification)))) |
Create a new Pulse by inserting it into the database along with all associated pieces of data such as: PulseCards, PulseChannels, and PulseChannelRecipients. Returns the newly created Pulse, or throws an Exception. | (mu/defn create-pulse!
{:style/indent 2}
[cards :- [:sequential [:map-of :keyword :any]]
channels :- [:sequential [:map-of :keyword :any]]
kvs :- [:map
[:name ms/NonBlankString]
[:creator_id ms/PositiveInt]
[:skip_if_empty {:optional true} [:maybe :boolean]]
[:collection_id {:optional true} [:maybe ms/PositiveInt]]
[:collection_position {:optional true} [:maybe ms/PositiveInt]]
[:dashboard_id {:optional true} [:maybe ms/PositiveInt]]
[:parameters {:optional true} [:maybe [:sequential :map]]]]]
(let [pulse-id (create-notification-and-add-cards-and-channels! kvs cards channels)]
;; return the full Pulse (and record our create event).
(u/prog1 (retrieve-pulse pulse-id)
(events/publish-event! :event/subscription-create {:object <>
:user-id api/*current-user-id*})))) |
Creates a pulse with the correct fields specified for an alert | (defn create-alert!
[alert creator-id card-id channels]
(let [id (-> alert
(assoc :skip_if_empty true, :creator_id creator-id)
(create-notification-and-add-cards-and-channels! [card-id] channels))]
;; return the full Pulse (and record our create event)
(retrieve-alert id))) |
(mu/defn ^:private notification-or-id->existing-card-refs :- [:sequential CardRef]
[notification-or-id]
(t2/select [PulseCard [:card_id :id] :include_csv :include_xls :dashboard_card_id]
:pulse_id (u/the-id notification-or-id)
{:order-by [[:position :asc]]})) | |
(mu/defn ^:private card-refs-have-changed? :- :boolean
[notification-or-id new-card-refs :- [:sequential CardRef]]
(not= (notification-or-id->existing-card-refs notification-or-id)
new-card-refs)) | |
(mu/defn ^:private update-notification-cards-if-changed! [notification-or-id new-card-refs]
(when (card-refs-have-changed? notification-or-id new-card-refs)
(update-notification-cards! notification-or-id new-card-refs))) | |
Update the supplied keys in a | (mu/defn update-notification!
[notification :- [:map
[:id ms/PositiveInt]
[:name {:optional true} ms/NonBlankString]
[:alert_condition {:optional true} AlertConditions]
[:alert_above_goal {:optional true} boolean?]
[:alert_first_only {:optional true} boolean?]
[:skip_if_empty {:optional true} boolean?]
[:collection_id {:optional true} [:maybe ms/PositiveInt]]
[:collection_position {:optional true} [:maybe ms/PositiveInt]]
[:cards {:optional true} [:sequential CoercibleToCardRef]]
[:channels {:optional true} [:sequential :map]]
[:archived {:optional true} boolean?]
[:parameters {:optional true} [:maybe [:sequential :map]]]]]
(t2/update! Pulse (u/the-id notification)
(u/select-keys-when notification
:present [:collection_id :collection_position :archived]
:non-nil [:name :alert_condition :alert_above_goal :alert_first_only :skip_if_empty :parameters]))
;; update Cards if the 'refs' have changed
(when (contains? notification :cards)
(update-notification-cards-if-changed! notification (map card->ref (:cards notification))))
;; update channels as needed
(when (contains? notification :channels)
(update-notification-channels! notification (:channels notification)))) |
Update an existing Pulse, including all associated data such as: PulseCards, PulseChannels, and PulseChannelRecipients. Returns the updated Pulse or throws an Exception. | (defn update-pulse!
[pulse]
(update-notification! pulse)
;; fetch the fully updated pulse, log an update event, and return it
(u/prog1 (retrieve-pulse (u/the-id pulse))
(events/publish-event! :event/subscription-update {:object <> :user-id api/*current-user-id*}))) |
Convert an 'Alert` back into the generic 'Notification' format. | (defn- alert->notification
[{:keys [card cards], :as alert}]
(let [card (or card (first cards))
cards (when card [(card->ref card)])]
(cond-> (-> (assoc alert :skip_if_empty true)
(dissoc :card))
(seq cards) (assoc :cards cards)))) |
Updates the given TODO - why do we make sure to strictly validate everything when we create a PULSE but not when we create an ALERT? | (defn update-alert!
[alert]
(update-notification! (alert->notification alert))
;; fetch the fully updated pulse, log an update event, and return it
(u/prog1 (retrieve-alert (u/the-id alert))
(events/publish-event! :event/alert-update {:object <> :user-id api/*current-user-id*}))) |
------------------------------------------------- Serialization -------------------------------------------------- | |
(defmethod serdes/extract-one "Pulse"
[_model-name _opts pulse]
(cond-> (serdes/extract-one-basics "Pulse" pulse)
(:collection_id pulse) (update :collection_id serdes/*export-fk* 'Collection)
(:dashboard_id pulse) (update :dashboard_id serdes/*export-fk* 'Dashboard)
true (update :creator_id serdes/*export-user*))) | |
(defmethod serdes/load-xform "Pulse" [pulse]
(cond-> (serdes/load-xform-basics pulse)
true (update :creator_id serdes/*import-user*)
(:collection_id pulse) (update :collection_id serdes/*import-fk* 'Collection)
(:dashboard_id pulse) (update :dashboard_id serdes/*import-fk* 'Dashboard))) | |
(defmethod serdes/dependencies "Pulse" [{:keys [collection_id dashboard_id]}]
(filterv some? [(when collection_id [{:model "Collection" :id collection_id}])
(when dashboard_id [{:model "Dashboard" :id dashboard_id}])])) | |
(ns metabase.models.pulse-card (:require [metabase.models.serialization :as serdes] [metabase.util :as u] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [methodical.core :as methodical] [toucan2.core :as t2])) | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase. | (def PulseCard :model/PulseCard) |
(methodical/defmethod t2/table-name :model/PulseCard [_model] :pulse_card) | |
(doto :model/PulseCard (derive :metabase/model) (derive :hook/entity-id)) | |
(defmethod serdes/hash-fields PulseCard [_pulse-card] [(serdes/hydrated-hash :pulse) (serdes/hydrated-hash :card) :position]) | |
Return the next available | (defn next-position-for
[pulse-id]
{:pre [(integer? pulse-id)]}
(-> (t2/select-one [PulseCard [:%max.position :max]] :pulse_id pulse-id)
:max
(some-> inc)
(or 0))) |
(def ^:private NewPulseCard
[:map {:closed true}
[:card_id ms/PositiveInt]
[:pulse_id ms/PositiveInt]
[:dashboard_card_id ms/PositiveInt]
[:position {:optional true} [:maybe ms/IntGreaterThanOrEqualToZero]]
[:include_csv {:optional true} [:maybe :boolean]]
[:include_xls {:optional true} [:maybe :boolean]]]) | |
Creates new PulseCards, joining the given card, pulse, and dashboard card and setting appropriate defaults for other values if they're not provided. | (mu/defn bulk-create!
[new-pulse-cards :- [:sequential NewPulseCard]]
(t2/insert! PulseCard
(for [{:keys [card_id pulse_id dashboard_card_id position include_csv include_xls]} new-pulse-cards]
{:card_id card_id
:pulse_id pulse_id
:dashboard_card_id dashboard_card_id
:position (u/or-with some? position (next-position-for pulse_id))
:include_csv (boolean include_csv)
:include_xls (boolean include_xls)}))) |
(defmethod serdes/generate-path "PulseCard"
[_ {:keys [pulse_id] :as card}]
[(serdes/infer-self-path "Pulse" (t2/select-one 'Pulse :id pulse_id))
(serdes/infer-self-path "PulseCard" card)]) | |
(defmethod serdes/extract-one "PulseCard"
[_model-name _opts card]
(cond-> (serdes/extract-one-basics "PulseCard" card)
true (update :card_id serdes/*export-fk* 'Card)
true (update :pulse_id serdes/*export-fk* 'Pulse)
(:dashboard_card_id card) (update :dashboard_card_id serdes/*export-fk* 'DashboardCard))) | |
(defmethod serdes/load-xform "PulseCard" [card]
(cond-> (serdes/load-xform-basics card)
true (update :card_id serdes/*import-fk* 'Card)
true (update :pulse_id serdes/*import-fk* 'Pulse)
true (dissoc :dashboard_id)
(:dashboard_card_id card) (update :dashboard_card_id serdes/*import-fk* 'DashboardCard))) | |
Depends on the Pulse, Card and (optional) dashboard card. | (defmethod serdes/dependencies "PulseCard" [{:keys [card_id dashboard_card_id pulse_id]}]
(let [base [[{:model "Card" :id card_id}]
[{:model "Pulse" :id pulse_id}]]]
(if-let [[dash-id _] dashboard_card_id]
(conj base [{:model "Dashboard" :id dash-id}])
base))) |
(ns metabase.models.pulse-channel (:require [clojure.set :as set] [medley.core :as m] [metabase.config :as config] [metabase.db.query :as mdb.query] [metabase.models.interface :as mi] [metabase.models.pulse-channel-recipient :refer [PulseChannelRecipient]] [metabase.models.serialization :as serdes] [metabase.models.user :as user :refer [User]] [metabase.plugins.classloader :as classloader] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [methodical.core :as methodical] [schema.core :as s] [toucan2.core :as t2])) | |
Static Definitions | |
Simple NOTE: order is important here!!
we use the same ordering as the clj-time | (def days-of-week
[{:id "mon", :name "Mon"},
{:id "tue", :name "Tue"},
{:id "wed", :name "Wed"},
{:id "thu", :name "Thu"},
{:id "fri", :name "Fri"},
{:id "sat", :name "Sat"},
{:id "sun", :name "Sun"}]) |
Is | (def ^{:arglists '([day])} day-of-week?
(partial contains? (set (map :id days-of-week)))) |
Is | (defn hour-of-day? [hour] (and (integer? hour) (<= 0 hour 23))) |
Set of possible schedule-frames allow for a PulseChannel. | (def ^:private schedule-frames
#{:first :mid :last}) |
Is | (defn schedule-frame? [frame] (contains? schedule-frames frame)) |
Set of the possible schedule-types allowed for a PulseChannel. | (def ^:private schedule-types
#{:hourly :daily :weekly :monthly}) |
Is | (defn schedule-type? [schedule-type] (contains? schedule-types schedule-type)) |
Is this combination of scheduling choices valid? | (defn valid-schedule?
[schedule-type schedule-hour schedule-day schedule-frame]
(or
;; hourly schedule does not care about other inputs
(= schedule-type :hourly)
;; daily schedule requires a valid `hour`
(and (= schedule-type :daily)
(hour-of-day? schedule-hour))
;; weekly schedule requires a valid `hour` and `day`
(and (= schedule-type :weekly)
(hour-of-day? schedule-hour)
(day-of-week? schedule-day))
;; monthly schedule requires a valid `hour` and `frame`. also a `day` if frame = first or last
(and (= schedule-type :monthly)
(schedule-frame? schedule-frame)
(hour-of-day? schedule-hour)
(or (contains? #{:first :last} schedule-frame)
(and (= :mid schedule-frame)
(nil? schedule-day)))))) |
Map which contains the definitions for each type of pulse channel we allow. Each key is a channel type with a map which contains any other relevant information for defining the channel. E.g. {:email {:name "Email", :recipients? true} :slack {:name "Slack", :recipients? false}} | (def channel-types
{:email {:type "email"
:name "Email"
:allows_recipients true
:recipients ["user" "email"]
:schedules [:hourly :daily :weekly :monthly]}
:slack {:type "slack"
:name "Slack"
:allows_recipients false
:schedules [:hourly :daily :weekly :monthly]
:fields [{:name "channel"
:type "select"
:displayName "Post to"
:options []
:required true}]}}) |
Is | (defn channel-type? [channel-type] (contains? (set (keys channel-types)) channel-type)) |
Does given | (defn supports-recipients? [channel] (boolean (:allows_recipients (get channel-types channel)))) |
Entity | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase. | (def PulseChannel :model/PulseChannel) |
(methodical/defmethod t2/table-name :model/PulseChannel [_model] :pulse_channel) (methodical/defmethod t2/model-for-automagic-hydration [:default :pulse_channel] [_original-model _k] :model/PulseChannel) | |
(doto :model/PulseChannel (derive :metabase/model) (derive :hook/timestamped?) (derive :hook/entity-id) (derive ::mi/read-policy.always-allow) (derive ::mi/write-policy.superuser)) | |
(t2/deftransforms :model/PulseChannel
{:details mi/transform-json
:channel_type mi/transform-keyword
:schedule_type mi/transform-keyword
:schedule_frame mi/transform-keyword}) | |
(mi/define-simple-hydration-method recipients
:recipients
"Return the `PulseChannelRecipients` associated with this `pulse-channel`."
[{pulse-channel-id :id, {:keys [emails]} :details}]
(concat
(for [email emails]
{:email email})
(t2/select
[User :id :email :first_name :last_name]
{:select [:u.id :u.email :u.first_name :u.last_name]
:from [[:core_user :u]]
:left-join [[:pulse_channel_recipient :pcr] [:= :u.id :pcr.user_id]]
:where [:and
[:= :pcr.pulse_channel_id pulse-channel-id]
[:= :u.is_active true]]
:order-by [[:u.id :asc]]}))) | |
Should we automatically archive a Pulse when its last | (def ^:dynamic *archive-parent-pulse-when-last-channel-is-deleted* true) |
(t2/define-before-delete :model/PulseChannel
[{pulse-id :pulse_id, pulse-channel-id :id}]
;; This function is called by [[metabase.models.pulse-channel/pre-delete]] when the `PulseChannel` is about to be
;; deleted. Archives `Pulse` if the channel being deleted is its last channel."
(when *archive-parent-pulse-when-last-channel-is-deleted*
(let [other-channels-count (t2/count PulseChannel :pulse_id pulse-id, :id [:not= pulse-channel-id])]
(when (zero? other-channels-count)
(t2/update! :model/Pulse pulse-id {:archived true}))))) | |
we want to load this at the top level so the Setting the namespace defines gets loaded | (def ^:private ^{:arglists '([email-addresses])} validate-email-domains*
(or (when config/ee-available?
(classloader/require 'metabase-enterprise.advanced-config.models.pulse-channel)
(resolve 'metabase-enterprise.advanced-config.models.pulse-channel/validate-email-domains))
(constantly nil))) |
For channels that are being sent to raw email addresses: check that the domains in the emails are allowed by
the [[metabase-enterprise.advanced-config.models.pulse-channel/subscription-allowed-domains]] Setting, if set. This
will no-op if | (defn validate-email-domains
[{{:keys [emails]} :details, :keys [recipients], :as pulse-channel}]
;; Raw email addresses can be in either `[:details :emails]` or in `:recipients`, depending on who is invoking this
;; function. Make sure we handle both situations.
;;
;; {:details {:emails [\"email@example.com\" ...]}}
;;
;; The Dashboard Subscription FE currently sends raw email address recipients in this format:
;;
;; {:recipients [{:email \"email@example.com\"} ...]}
;;
(u/prog1 pulse-channel
(let [raw-email-recipients (remove :id recipients)
user-recipients (filter :id recipients)
emails (concat emails (map :email raw-email-recipients))]
(validate-email-domains* emails)
;; validate User `:id` & `:email` match up for User recipients. This is mostly to make sure people don't try to
;; be sneaky and pass in a valid User ID but different email so they can send test Pulses out to arbitrary email
;; addresses
(when-let [user-ids (not-empty (into #{} (comp (filter some?) (map :id)) user-recipients))]
(let [user-id->email (t2/select-pk->fn :email User, :id [:in user-ids])]
(doseq [{:keys [id email]} user-recipients
:let [correct-email (get user-id->email id)]]
(when-not correct-email
(throw (ex-info (tru "User {0} does not exist." id)
{:status-code 404})))
;; only validate the email address if it was explicitly specified, which is not explicitly required.
(when (and email
(not= email correct-email))
(throw (ex-info (tru "Wrong email address for User {0}." id)
{:status-code 403}))))))))) |
(t2/define-before-insert :model/PulseChannel [pulse-channel] (validate-email-domains pulse-channel)) | |
(t2/define-before-update :model/PulseChannel [pulse-channel] (validate-email-domains (mi/pre-update-changes pulse-channel))) | |
(defmethod serdes/hash-fields PulseChannel [_pulse-channel] [(serdes/hydrated-hash :pulse) :channel_type :details :created_at]) | |
Persistence Functions | |
Fetch all Examples: (retrieve-scheduled-channels 14 "mon" :first :first) - 2pm on the first Monday of the month (retrieve-scheduled-channels 8 "wed" :other :last) - 8am on Wednesday of the last week of the month Based on the given input the appropriate
| (s/defn retrieve-scheduled-channels
[hour :- (s/maybe s/Int)
weekday :- (s/maybe (s/pred day-of-week?))
monthday :- (s/enum :first :last :mid :other)
monthweek :- (s/enum :first :last :other)]
(let [schedule-frame (cond
(= :mid monthday) "mid"
(= :first monthweek) "first"
(= :last monthweek) "last"
:else "invalid")
monthly-schedule-day-or-nil (when (= :other monthday)
weekday)]
(t2/select [PulseChannel :id :pulse_id :schedule_type :channel_type]
{:where [:and [:= :enabled true]
[:or [:= :schedule_type "hourly"]
[:and [:= :schedule_type "daily"]
[:= :schedule_hour hour]]
[:and [:= :schedule_type "weekly"]
[:= :schedule_hour hour]
[:= :schedule_day weekday]]
[:and [:= :schedule_type "monthly"]
[:= :schedule_hour hour]
[:= :schedule_frame schedule-frame]
[:or [:= :schedule_day weekday]
;; this is here specifically to allow for cases where day doesn't have to match
[:= :schedule_day monthly-schedule-day-or-nil]]]]]}))) |
Update the
| (defn update-recipients!
[id user-ids]
{:pre [(integer? id)
(coll? user-ids)
(every? integer? user-ids)]}
(let [recipients-old (set (t2/select-fn-set :user_id PulseChannelRecipient, :pulse_channel_id id))
recipients-new (set user-ids)
recipients+ (set/difference recipients-new recipients-old)
recipients- (set/difference recipients-old recipients-new)]
(when (seq recipients+)
(let [vs (map #(assoc {:pulse_channel_id id} :user_id %) recipients+)]
(t2/insert! PulseChannelRecipient vs)))
(when (seq recipients-)
(t2/delete! (t2/table-name PulseChannelRecipient)
:pulse_channel_id id
:user_id [:in recipients-])))) |
Updates an existing | (defn update-pulse-channel!
[{:keys [id channel_type enabled details recipients schedule_type schedule_day schedule_hour schedule_frame]
:or {details {}
recipients []}}]
{:pre [(integer? id)
(channel-type? channel_type)
(m/boolean? enabled)
(schedule-type? schedule_type)
(valid-schedule? schedule_type schedule_hour schedule_day schedule_frame)
(coll? recipients)
(every? map? recipients)]}
(let [recipients-by-type (group-by integer? (filter identity (map #(or (:id %) (:email %)) recipients)))]
(t2/update! PulseChannel id
{:details (cond-> details
(supports-recipients? channel_type) (assoc :emails (get recipients-by-type false)))
:enabled enabled
:schedule_type schedule_type
:schedule_hour (when (not= schedule_type :hourly)
schedule_hour)
:schedule_day (when (contains? #{:weekly :monthly} schedule_type)
schedule_day)
:schedule_frame (when (= schedule_type :monthly)
schedule_frame)})
(when (supports-recipients? channel_type)
(update-recipients! id (or (get recipients-by-type true) []))))) |
Create a new | (defn create-pulse-channel!
[{:keys [channel_type details enabled pulse_id recipients schedule_type schedule_day schedule_hour schedule_frame]
:or {details {}
recipients []}}]
{:pre [(channel-type? channel_type)
(integer? pulse_id)
(boolean? enabled)
(schedule-type? schedule_type)
(valid-schedule? schedule_type schedule_hour schedule_day schedule_frame)
(coll? recipients)
(every? map? recipients)]}
(let [recipients-by-type (group-by integer? (filter identity (map #(or (:id %) (:email %)) recipients)))
{:keys [id]} (first (t2/insert-returning-instances!
PulseChannel
:pulse_id pulse_id
:channel_type channel_type
:details (cond-> details
(supports-recipients? channel_type) (assoc :emails (get recipients-by-type false)))
:enabled enabled
:schedule_type schedule_type
:schedule_hour (when (not= schedule_type :hourly)
schedule_hour)
:schedule_day (when (contains? #{:weekly :monthly} schedule_type)
schedule_day)
:schedule_frame (when (= schedule_type :monthly)
schedule_frame)))]
(when (and (supports-recipients? channel_type) (seq (get recipients-by-type true)))
(update-recipients! id (get recipients-by-type true)))
;; return the id of our newly created channel
id)) |
(methodical/defmethod mi/to-json PulseChannel "Don't include `:emails`, we use that purely internally" [pulse-channel json-generator] (next-method (m/dissoc-in pulse-channel [:details :emails]) json-generator)) | |
(defmethod serdes/generate-path "PulseChannel"
[_ {:keys [pulse_id] :as channel}]
[(serdes/infer-self-path "Pulse" (t2/select-one 'Pulse :id pulse_id))
(serdes/infer-self-path "PulseChannel" channel)]) | |
(defmethod serdes/extract-one "PulseChannel"
[_model-name _opts channel]
(let [recipients (mapv :email (mdb.query/query {:select [:user.email]
:from [[:pulse_channel_recipient :pcr]]
:join [[:core_user :user] [:= :user.id :pcr.user_id]]
:where [:= :pcr.pulse_channel_id (:id channel)]}))]
(-> (serdes/extract-one-basics "PulseChannel" channel)
(update :pulse_id serdes/*export-fk* 'Pulse)
(assoc :recipients recipients)))) | |
(defmethod serdes/load-xform "PulseChannel" [channel]
(-> channel
serdes/load-xform-basics
(update :pulse_id serdes/*import-fk* 'Pulse))) | |
(defn- import-recipients [channel-id emails]
(let [incoming-users (set (for [email emails
:let [id (t2/select-one-pk 'User :email email)]]
(or id
(:id (user/serdes-synthesize-user! {:email email})))))
current-users (set (t2/select-fn-set :user_id PulseChannelRecipient :pulse_channel_id channel-id))
combined (set/union incoming-users current-users)]
(when-not (empty? combined)
(update-recipients! channel-id combined)))) | |
Customized load-insert! and load-update! to handle the embedded recipients field - it's really a separate table. | (defmethod serdes/load-insert! "PulseChannel" [_ ingested]
(let [;; Call through to the default load-insert!
chan ((get-method serdes/load-insert! "") "PulseChannel" (dissoc ingested :recipients))]
(import-recipients (:id chan) (:recipients ingested))
chan)) |
(defmethod serdes/load-update! "PulseChannel" [_ ingested local]
;; Call through to the default load-update!
(let [chan ((get-method serdes/load-update! "") "PulseChannel" (dissoc ingested :recipients) local)]
(import-recipients (:id local) (:recipients ingested))
chan)) | |
Depends on the Pulse. | (defmethod serdes/dependencies "PulseChannel" [{:keys [pulse_id]}]
[[{:model "Pulse" :id pulse_id}]]) |
(ns metabase.models.pulse-channel-recipient (:require [methodical.core :as methodical] [toucan2.core :as t2])) | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase. | (def PulseChannelRecipient :model/PulseChannelRecipient) |
(methodical/defmethod t2/table-name :model/PulseChannelRecipient [_model] :pulse_channel_recipient) | |
(derive :model/PulseChannelRecipient :metabase/model) | |
Deletes | (t2/define-before-delete :model/PulseChannelRecipient
[{channel-id :pulse_channel_id, pulse-channel-recipient-id :id}]
(let [other-recipients-count (t2/count PulseChannelRecipient
:pulse_channel_id channel-id
:id [:not= pulse-channel-recipient-id])
last-recipient? (zero? other-recipients-count)]
(when last-recipient?
;; make sure this channel doesn't have any email-address (non-User) recipients.
(let [details (t2/select-one-fn :details :model/PulseChannel :id channel-id)
has-email-addresses? (seq (:emails details))]
(when-not has-email-addresses?
(t2/delete! :model/PulseChannel :id channel-id)))))) |
Functions related to the 'Query' model, which records stuff such as average query execution time. | (ns metabase.models.query (:require [cheshire.core :as json] [clojure.walk :as walk] [metabase.db :as mdb] [metabase.mbql.normalize :as mbql.normalize] [metabase.models.interface :as mi] [metabase.util.honey-sql-2 :as h2x] [methodical.core :as methodical] [toucan2.core :as t2] [toucan2.model :as t2.model])) |
(set! *warn-on-reflection* true) | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase. | (def Query :model/Query) |
(methodical/defmethod t2/table-name :model/Query [_model] :query) (methodical/defmethod t2.model/primary-keys :model/Query [_model] [:query_hash]) | |
(t2/deftransforms :model/Query
{:query mi/transform-json}) | |
(derive :model/Query :metabase/model) | |
Helper Fns | |
Fetch the average execution time (in milliseconds) for query with QUERY-HASH if available.
Returns | (defn average-execution-time-ms
^Integer [^bytes query-hash]
{:pre [(instance? (Class/forName "[B") query-hash)]}
(t2/select-one-fn :average_execution_time Query :query_hash query-hash)) |
Return appropriate type for use in SQL | (defn- int-casting-type
[]
(if (= (mdb/db-type) :mysql)
:unsigned
:integer)) |
Update the rolling average execution time for query with | (defn- update-rolling-average-execution-time!
^Boolean [query ^bytes query-hash ^Integer execution-time-ms]
(let [avg-execution-time (h2x/cast (int-casting-type) (h2x/round (h2x/+ (h2x/* [:inline 0.9] :average_execution_time)
[:inline (* 0.1 execution-time-ms)])
[:inline 0]))]
(or
;; if it DOES NOT have a query (yet) set that. In 0.31.0 we added the query.query column, and it gets set for all
;; new entries, so at some point in the future we can take this out, and save a DB call.
(pos? (t2/update! Query
{:query_hash query-hash, :query nil}
{:query (json/generate-string query)
:average_execution_time avg-execution-time}))
;; if query is already set then just update average_execution_time. (We're doing this separate call to avoid
;; updating query on every single UPDATE)
(pos? (t2/update! Query
{:query_hash query-hash}
{:average_execution_time avg-execution-time}))))) |
Record a query and its execution time for a | (defn- record-new-query-entry!
[query ^bytes query-hash ^Integer execution-time-ms]
(first (t2/insert-returning-instances! Query
:query query
:query_hash query-hash
:average_execution_time execution-time-ms))) |
Update the recorded average execution time (or insert a new record if needed) for | (defn save-query-and-update-average-execution-time!
[query, ^bytes query-hash, ^Integer execution-time-ms]
{:pre [(instance? (Class/forName "[B") query-hash)]}
(or
;; if there's already a matching Query update the rolling average
(update-rolling-average-execution-time! query query-hash execution-time-ms)
;; otherwise try adding a new entry. If for some reason there was a race condition and a Query entry was added in
;; the meantime we'll try updating that existing record
(try (record-new-query-entry! query query-hash execution-time-ms)
(catch Throwable e
(or (update-rolling-average-execution-time! query query-hash execution-time-ms)
;; rethrow e if updating an existing average execution time failed
(throw e)))))) |
Return a map with | (defn query->database-and-table-ids
[{database-id :database, query-type :type, {:keys [source-table source-query]} :query}]
(cond
(= :native query-type) {:database-id database-id, :table-id nil}
(integer? source-table) {:database-id database-id, :table-id source-table}
(string? source-table) (let [[_ card-id] (re-find #"^card__(\d+)$" source-table)]
(t2/select-one ['Card [:table_id :table-id] [:database_id :database-id]]
:id (Integer/parseInt card-id)))
(map? source-query) (query->database-and-table-ids {:database database-id
:type query-type
:query source-query}))) |
Return the ID of the card used as source table, if applicable; otherwise return | (defn- parse-source-query-id
[source-table]
(when (string? source-table)
(when-let [[_ card-id-str] (re-matches #"card__(\d+)" source-table)]
(parse-long card-id-str)))) |
Return a sequence of model ids referenced in the MBQL query | (defn collect-card-ids
[mbql-form]
(let [ids (java.util.HashSet.)
walker (fn [form]
(when (map? form)
;; model references in native queries
(when-let [card-id (:card-id form)]
(when (int? card-id)
(.add ids card-id)))
;; source tables (possibly in joins)
(when-let [card-id (parse-source-query-id (:source-table form))]
(.add ids card-id)))
form)]
(walk/prewalk walker mbql-form)
(seq ids))) |
Wrap query map into a Query object (mostly to facilitate type dispatch). | (defn adhoc-query
[query]
(->> query
mbql.normalize/normalize
(hash-map :dataset_query)
(merge (query->database-and-table-ids query))
(mi/instance Query))) |
A model used to cache query results in the database. | (ns metabase.models.query-cache (:require [methodical.core :as methodical] [toucan2.core :as t2])) |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase. | (def QueryCache :model/QueryCache) |
(methodical/defmethod t2/table-name :model/QueryCache [_model] :query_cache) (methodical/defmethod t2/primary-keys QueryCache [_model] [:query_hash]) | |
(doto :model/QueryCache (derive :metabase/model) (derive :hook/updated-at-timestamped?)) | |
QueryExecution is a log of very time a query is executed, and other information such as the User who executed it, run time, context it was executed in, etc. | (ns metabase.models.query-execution (:require [malli.core :as mc] [malli.error :as me] [metabase.mbql.schema :as mbql.s] [metabase.models.interface :as mi] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [methodical.core :as methodical] [toucan2.core :as t2])) |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase. | (def QueryExecution :model/QueryExecution) |
(methodical/defmethod t2/table-name :model/QueryExecution [_model] :query_execution) | |
(derive :model/QueryExecution :metabase/model) | |
(t2/deftransforms :model/QueryExecution
{:json_query mi/transform-json
:status mi/transform-keyword
:context mi/transform-keyword}) | |
(defn- validate-context [context]
(when-let [error (me/humanize (mc/explain mbql.s/Context context))]
(throw (ex-info (tru "Invalid query execution context: {0}" (pr-str error))
{:error error})))) | |
(t2/define-before-insert :model/QueryExecution
[{context :context, :as query-execution}]
(u/prog1 query-execution
(validate-context context))) | |
(t2/define-after-select :model/QueryExecution
[{:keys [result_rows] :as query-execution}]
;; sadly we have 2 ways to reference the row count :(
(assoc query-execution :row_count (or result_rows 0))) | |
(t2/define-before-update :model/QueryExecution [_query-execution] (throw (Exception. (tru "You cannot update a QueryExecution!")))) | |
Functions used to calculate the permissions needed to run a query based on old-style DATA ACCESS PERMISSIONS. The only thing that is subject to these sorts of checks are ad-hoc queries, i.e. queries that have not yet been saved as a Card. Saved Cards are subject to the permissions of the Collection to which they belong. | (ns metabase.models.query.permissions (:require [metabase.api.common :as api] [metabase.lib.metadata :as lib.metadata] [metabase.lib.schema.id :as lib.schema.id] [metabase.mbql.normalize :as mbql.normalize] [metabase.mbql.util :as mbql.u] [metabase.models.interface :as mi] [metabase.models.permissions :as perms] [metabase.permissions.util :as perms.u] [metabase.query-processor.store :as qp.store] [metabase.query-processor.util :as qp.util] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
---------------------------------------------- Permissions Checking ---------------------------------------------- | |
Is calculating permissions for queries complicated? Some would say so. Refer to this handy flow chart to see how things get calculated.
adhoc-native-query-path mbql-perms-path-set | no source card <------+----> has source card ↓ ↓ tables->permissions-path-set source-card-read-perms ↓ table-query-path
| |
(mu/defn query->source-table-ids :- [:set [:or [:= ::native] ms/PositiveInt]]
"Return a sequence of all Table IDs referenced by `query`."
[query]
(set
(flatten
(mbql.u/match query
;; if we come across a native query just put a placeholder (`::native`) there so we know we need to
;; add native permissions to the complete set below.
(m :guard (every-pred map? :native))
[::native]
(m :guard (every-pred map? :source-table))
(cons
(:source-table m)
(query->source-table-ids (dissoc m :source-table))))))) | |
Map of options to be passed to the permissions checking functions. | (def ^:private PermsOptions
[:map
[:segmented-perms? {:optional true} :boolean]
[:throw-exceptions? {:optional true} [:maybe :boolean]]
[:already-preprocessed? {:optional true} :boolean]
[:table-perms-fn {:optional true} fn?]
[:native-perms-fn {:optional true} fn?]]) |
(def ^:private TableOrIDOrNativePlaceholder [:or [:= ::native] ms/PositiveInt]) | |
(mu/defn ^:private table-ids->id->schema :- [:maybe [:map-of ::lib.schema.id/table [:maybe :string]]]
[table-ids :- [:maybe [:sequential ::lib.schema.id/table]]]
(when (seq table-ids)
(if (qp.store/initialized?)
(into {}
(map (fn [table-id]
((juxt :id :schema) (lib.metadata/table (qp.store/metadata-provider) table-id))))
table-ids)
(t2/select-pk->fn :schema :model/Table :id [:in table-ids])))) | |
(mu/defn tables->permissions-path-set :- [:set perms.u/PathSchema]
"Given a sequence of `tables-or-ids` referenced by a query, return a set of required permissions. A truthy value for
`segmented-perms?` will return segmented permissions for the table rather that full table permissions.
Custom `table-perms-fn` and `native-perms-fn` can be passed as options to generate permissions paths for feature-level
permissions, such as download permissions."
[database-or-id :- [:or ms/PositiveInt :map]
tables-or-ids :- [:set TableOrIDOrNativePlaceholder]
{:keys [segmented-perms?
table-perms-fn
native-perms-fn]} :- PermsOptions]
(let [table-ids (filter integer? tables-or-ids)
table-id->schema (table-ids->id->schema table-ids)
table-or-id->schema #(if (integer? %)
(table-id->schema %)
(:schema %))
native-perms-fn (or native-perms-fn perms/adhoc-native-query-path)
table-perms-fn (or table-perms-fn
(if segmented-perms?
perms/table-sandboxed-query-path
perms/table-query-path))]
(set (for [table-or-id tables-or-ids]
(if (= ::native table-or-id)
;; Any `::native` placeholders from above mean we need native ad-hoc query permissions for this DATABASE
(native-perms-fn database-or-id)
;; anything else (i.e., a normal table) just gets normal table permissions
(table-perms-fn (u/the-id database-or-id)
(table-or-id->schema table-or-id)
(u/the-id table-or-id))))))) | |
(mu/defn ^:private card-instance :- [:and
(ms/InstanceOf :model/Card)
[:map [:collection_id [:maybe ms/PositiveInt]]]]
[card-id :- ::lib.schema.id/card]
(or (if (qp.store/initialized?)
(when-let [{:keys [collection-id]} (lib.metadata/card (qp.store/metadata-provider) card-id)]
(t2/instance :model/Card {:collection_id collection-id}))
(t2/select-one [:model/Card :collection_id] :id card-id))
(throw (Exception. (tru "Card {0} does not exist." card-id))))) | |
(mu/defn ^:private source-card-read-perms :- [:set perms.u/PathSchema] "Calculate the permissions needed to run an ad-hoc query that uses a Card with `source-card-id` as its source query." [source-card-id :- ::lib.schema.id/card] (mi/perms-objects-set (card-instance source-card-id) :read)) | |
(defn- preprocess-query [query]
;; ignore the current user for the purposes of calculating the permissions required to run the query. Don't want the
;; preprocessing to fail because current user doesn't have permissions to run it when we're not trying to run it at
;; all
(binding [api/*current-user-id* nil]
((resolve 'metabase.query-processor/preprocess) query))) | |
(mu/defn ^:private mbql-permissions-path-set :- [:set perms.u/PathSchema]
"Return the set of required permissions needed to run an adhoc `query`.
Also optionally specify `throw-exceptions?` -- normally this function avoids throwing Exceptions to avoid breaking
things when a single Card is busted (e.g. API endpoints that filter out unreadable Cards) and instead returns 'only
admins can see this' permissions -- `#{\"db/0\"}` (DB 0 will never exist, thus normal users will never be able to
get permissions for it, but admins have root perms and will still get to see (and hopefully fix) it)."
[query :- [:map [:query ms/Map]]
{:keys [throw-exceptions? already-preprocessed?], :as perms-opts} :- PermsOptions]
(try
(let [query (mbql.normalize/normalize query)]
;; if we are using a Card as our source, our perms are that Card's (i.e. that Card's Collection's) read perms
(if-let [source-card-id (qp.util/query->source-card-id query)]
(source-card-read-perms source-card-id)
;; otherwise if there's no source card then calculate perms based on the Tables referenced in the query
(let [{:keys [query database]} (cond-> query
(not already-preprocessed?) preprocess-query)]
(tables->permissions-path-set database (query->source-table-ids query) perms-opts))))
;; if for some reason we can't expand the Card (i.e. it's an invalid legacy card) just return a set of permissions
;; that means no one will ever get to see it (except for superusers who get to see everything)
(catch Throwable e
(let [e (ex-info "Error calculating permissions for query"
{:query (or (u/ignore-exceptions (mbql.normalize/normalize query))
query)}
e)]
(when throw-exceptions?
(throw e))
(log/error e))
#{"/db/0/"}))) ; DB 0 will never exist | |
(mu/defn ^:private perms-set* :- [:set perms.u/PathSchema]
"Does the heavy lifting of creating the perms set. `opts` will indicate whether exceptions should be thrown and
whether full or segmented table permissions should be returned."
[{query-type :type, database :database, :as query} perms-opts :- PermsOptions]
(cond
(empty? query) #{}
(= (keyword query-type) :native) #{(perms/adhoc-native-query-path database)}
(= (keyword query-type) :query) (mbql-permissions-path-set query perms-opts)
:else (throw (ex-info (tru "Invalid query type: {0}" query-type)
{:query query})))) | |
Calculate the set of permissions including segmented (not full) table permissions. | (defn segmented-perms-set
{:arglists '([query & {:keys [throw-exceptions? already-preprocessed?]}])}
[query & {:as perms-opts}]
(perms-set* query (assoc perms-opts :segmented-perms? true))) |
Calculate the set of permissions required to run an ad-hoc | (defn perms-set
{:arglists '([query & {:keys [throw-exceptions? already-preprocessed?]}])}
[query & {:as perms-opts}]
(perms-set* query (assoc perms-opts :segmented-perms? false))) |
Return | (mu/defn can-run-query?
[query]
(let [user-perms @api/*current-user-permissions-set*]
(or (perms/set-has-full-permissions-for-set? user-perms (perms-set query))
(perms/set-has-full-permissions-for-set? user-perms (segmented-perms-set query))))) |
Does the current user have permissions to run an ad-hoc query against the Table with | (defn can-query-table?
[database-id table-id]
(can-run-query? {:database database-id
:type :query
:query {:source-table table-id}})) |
The Recent Views table is used to track the most recent views of objects such as Cards, Tables and Dashboards for each user. | (ns metabase.models.recent-views
(:require
#_{:clj-kondo/ignore [:deprecated-namespace]}
[java-time :as t]
[metabase.util :as u]
[metabase.util.honey-sql-2 :as h2x]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[methodical.core :as m]
[steffan-westcott.clj-otel.api.trace.span :as span]
[toucan2.core :as t2])) |
(doto :model/RecentViews (derive :metabase/model)) | |
(m/defmethod t2/table-name :model/RecentViews [_model] :recent_views) | |
(t2/define-before-insert :model/RecentViews
[log-entry]
(let [defaults {:timestamp :%now}]
(merge defaults log-entry))) | |
The number of recently viewed items to keep per user. This should be larger than the number of items returned by the /api/activity/recent_views endpoint, but it should still be lightweight to read all of a user's recent views at once. | (def ^:private ^:dynamic *recent-views-stored-per-user* 30) |
Returns a set of view IDs to prune from the RecentViews table so we only keep the most recent n views per user. Ensures that we keep the most recent dashboard view for the user. | (defn- view-ids-to-prune
[prior-views n]
(if (< (count prior-views) n)
[]
(let [ids-to-keep (map :id (take n prior-views))
;; We want to make sure we keep the most recent dashboard view for the user
ids-to-prune (map :id (drop n prior-views))
most-recent-dashboard-id (->> prior-views (filter #(= "dashboard" (:model %))) first :id)
pruning-most-recent-dashboard? ((set ids-to-prune) most-recent-dashboard-id)]
(if pruning-most-recent-dashboard?
(conj (remove #{most-recent-dashboard-id} (set ids-to-prune))
(last ids-to-keep))
ids-to-prune)))) |
Updates the RecentViews table for a given user with a new view, and prunes old views. | (mu/defn update-users-recent-views!
[user-id :- [:maybe ms/PositiveInt]
model :- [:or
[:enum :model/Card :model/Table :model/Dashboard]
:string]
model-id :- ms/PositiveInt]
(when user-id
(span/with-span!
{:name "update-users-recent-views!"
:attributes {:model/id model-id
:user/id user-id
:model/name (u/lower-case-en model)}}
(t2/with-transaction [_conn]
(t2/insert! :model/RecentViews {:user_id user-id
:model (u/lower-case-en (name model))
:model_id model-id})
(let [current-views (t2/select :model/RecentViews :user_id user-id {:order-by [[:id :desc]]})
ids-to-prune (view-ids-to-prune current-views *recent-views-stored-per-user*)]
(when (seq ids-to-prune)
(t2/delete! :model/RecentViews :id [:in ids-to-prune]))))))) |
Returns ID of the most recently viewed dashboard for a given user within the last 24 hours, or | (defn most-recently-viewed-dashboard-id
[user-id]
(t2/select-one-fn
:model_id
:model/RecentViews
{:where [:and
[:= :user_id user-id]
[:= :model (h2x/literal "dashboard")]
[:> :timestamp (t/minus (t/zoned-date-time) (t/days 1))]]
:order-by [[:id :desc]]})) |
Returns the most recent | (defn user-recent-views
([user-id]
(user-recent-views user-id *recent-views-stored-per-user*))
([user-id n]
(let [all-user-views (t2/select-fn-vec #(select-keys % [:model :model_id])
:model/RecentViews
:user_id user-id
{:order-by [[:id :desc]]
:limit *recent-views-stored-per-user*})]
(->> (distinct all-user-views)
(take n)
;; Lower-case the model name, since that's what the FE expects
(map #(update % :model u/lower-case-en)))))) |
(ns metabase.models.revision (:require [cheshire.core :as json] [clojure.data :as data] [metabase.config :as config] [metabase.db.util :as mdb.u] [metabase.models.interface :as mi] [metabase.models.revision.diff :refer [diff-strings*]] [metabase.util :as u] [metabase.util.i18n :refer [deferred-tru tru]] [metabase.util.malli :as mu] [methodical.core :as methodical] [toucan2.core :as t2] [toucan2.model :as t2.model])) | |
Maximum number of revisions to keep for each individual object. After this limit is surpassed, the oldest revisions will be deleted. | (def ^:const max-revisions 15) |
Prepare an instance for serialization in a Revision. | (defmulti serialize-instance
{:arglists '([model id instance])}
mi/dispatch-on-model) |
no default implementation for [[serialize-instance]]; models need to implement this themselves. | |
Return an object to the state recorded by | (defmulti revert-to-revision!
{:arglists '([model id user-id serialized-instance])}
mi/dispatch-on-model) |
(defmethod revert-to-revision! :default [model id _user-id serialized-instance] (t2/update! model id, serialized-instance)) | |
Return a map describing the difference between | (defmulti diff-map
{:arglists '([model object-1 object-2])}
mi/dispatch-on-model) |
(defmethod diff-map :default
[_model o1 o2]
(when o1
(let [[before after] (data/diff o1 o2)]
{:before before
:after after}))) | |
Return a seq of string describing the difference between Each string in the seq should be i18n-ed. | (defmulti diff-strings
{:arglists '([model object-1 object-2])}
mi/dispatch-on-model) |
(defmethod diff-strings :default [model o1 o2] (diff-strings* (name model) o1 o2)) | |
----------------------------------------------- Entity & Lifecycle ----------------------------------------------- | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase. | (def Revision :model/Revision) |
(methodical/defmethod t2/table-name :model/Revision [_model] :revision) | |
(doto :model/Revision (derive :metabase/model)) | |
(t2/deftransforms :model/Revision
{:object mi/transform-json}) | |
(t2/define-before-insert :model/Revision
[revision]
(assoc revision
:timestamp :%now
:metabase_version config/mb-version-string
:most_recent true)) | |
(t2/define-before-update :model/Revision [_revision] (fn [& _] (throw (Exception. (tru "You cannot update a Revision!"))))) | |
(t2/define-after-select :model/Revision
;; Call the appropriate `post-select` methods (including the type functions) on the `:object` this Revision recorded.
;; This is important for things like Card revisions, where the `:dataset_query` property needs to be normalized when
;; coming out of the DB.
[{:keys [model] :as revision}]
;; in some cases (such as tests) we have 'fake' models that cannot be resolved normally; don't fail entirely in
;; those cases
(let [model (u/ignore-exceptions (t2.model/resolve-model (symbol model)))]
(cond-> revision
model (update :object (partial mi/do-after-select model))))) | |
Delete old revisions of | (defn- delete-old-revisions!
[model id]
(when-let [old-revisions (seq (drop max-revisions (t2/select-fn-vec :id :model/Revision
:model (name model)
:model_id id
{:order-by [[:timestamp :desc]
[:id :desc]]})))]
(t2/delete! :model/Revision :id [:in old-revisions]))) |
(t2/define-after-insert :model/Revision
[revision]
(u/prog1 revision
(let [{:keys [id model model_id]} revision]
;; Note 1: Update the last `most_recent revision` to false (not including the current revision)
;; Note 2: We don't allow updating revision but this is a special case, so we by pass the check by
;; updating directly with the table name
(t2/update! (t2/table-name :model/Revision)
{:model model :model_id model_id :most_recent true :id [:not= id]}
{:most_recent false})
(delete-old-revisions! model model_id)))) | |
Functions | |
(defn- revision-changes
[model prev-revision revision]
(cond
(:is_creation revision) [(deferred-tru "created this")]
(:is_reversion revision) [(deferred-tru "reverted to an earlier version")]
;; We only keep [[revision/max-revisions]] number of revision per entity.
;; prev-revision can be nil when we generate description for oldest revision
(nil? prev-revision) [(deferred-tru "modified this")]
:else (diff-strings model (:object prev-revision) (:object revision)))) | |
(defn- revision-description-info
[model prev-revision revision]
(let [changes (revision-changes model prev-revision revision)]
{:description (if (seq changes)
(u/build-sentence changes)
;; HACK: before #30285 we record revision even when there is nothing changed,
;; so there are cases when revision can comeback as `nil`.
;; This is a safe guard for us to not display "Crowberto null" as
;; description on UI
(deferred-tru "created a revision with no change."))
;; this is used on FE
:has_multiple_changes (> (count changes) 1)})) | |
Add enriched revision data such as | (defn add-revision-details
[model revision prev-revision]
(-> revision
(assoc :diff (diff-map model (:object prev-revision) (:object revision)))
(merge (revision-description-info model prev-revision revision))
;; add revision user details
(t2/hydrate :user)
(update :user select-keys [:id :first_name :last_name :common_name])
;; Filter out irrelevant info
(dissoc :model :model_id :user_id :object))) |
Get the revisions for | (mu/defn revisions
[model :- [:fn mdb.u/toucan-model?]
id :- pos-int?]
(t2/select Revision :model (name model) :model_id id {:order-by [[:id :desc]]})) |
Fetch | (mu/defn revisions+details
[model :- [:fn mdb.u/toucan-model?]
id :- pos-int?]
(when-let [revisions (revisions model id)]
(loop [acc [], [r1 r2 & more] revisions]
(if-not r2
(conj acc (add-revision-details model r1 nil))
(recur (conj acc (add-revision-details model r1 r2))
(conj more r2)))))) |
Record a new Revision for | (mu/defn push-revision!
[{:keys [id entity user-id object
is-creation? message]
:or {is-creation? false}} :- [:map {:closed true}
[:id pos-int?]
[:object :map]
[:entity [:fn mdb.u/toucan-model?]]
[:user-id pos-int?]
[:is-creation? {:optional true} [:maybe :boolean]]
[:message {:optional true} [:maybe :string]]]]
(let [serialized-object (serialize-instance entity id (dissoc object :message))
last-object (t2/select-one-fn :object Revision :model (name entity) :model_id id {:order-by [[:id :desc]]})]
;; make sure we still have a map after calling out serialization function
(assert (map? serialized-object))
;; the last-object could have nested object, e.g: Dashboard can have multiple Card in it,
;; even though we call `post-select` on the `object`, the nested object might not be transformed correctly
;; E.g: Cards inside Dashboard will not be transformed
;; so to be safe, we'll just compare them as string
(when-not (= (json/generate-string serialized-object)
(json/generate-string last-object))
(t2/insert! Revision
:model (name entity)
:model_id id
:user_id user-id
:object serialized-object
:is_creation is-creation?
:is_reversion false
:message message)
object))) |
Revert | (mu/defn revert!
[info :- [:map {:closed true}
[:id pos-int?]
[:user-id pos-int?]
[:revision-id pos-int?]
[:entity [:fn mdb.u/toucan-model?]]]]
(let [{:keys [id user-id revision-id entity]} info
serialized-instance (t2/select-one-fn :object Revision :model (name entity) :model_id id :id revision-id)]
(t2/with-transaction [_conn]
;; Do the reversion of the object
(revert-to-revision! entity id user-id serialized-instance)
;; Push a new revision to record this change
(let [last-revision (t2/select-one Revision :model (name entity), :model_id id, {:order-by [[:id :desc]]})
new-revision (first (t2/insert-returning-instances! Revision
:model (name entity)
:model_id id
:user_id user-id
:object serialized-instance
:is_creation false
:is_reversion true))]
(add-revision-details entity new-revision last-revision))))) |
(ns metabase.models.revision.diff (:require [clojure.core.match :refer [match]] [clojure.data :as data] [metabase.util.i18n :refer [deferred-tru]] [toucan2.core :as t2])) | |
(defn- diff-string [k v1 v2 identifier]
(match [k v1 v2]
[:name _ _]
(deferred-tru "renamed {0} from \"{1}\" to \"{2}\ identifier v1 v2)
[:description nil _]
(deferred-tru "added a description")
[:description (_ :guard some?) _]
(deferred-tru "changed the description")
[:private true false]
(deferred-tru "made {0} public" identifier)
[:private false true]
(deferred-tru "made {0} private" identifier)
[:public_uuid _ nil]
(deferred-tru "made {0} private" identifier)
[:public_uuid nil _]
(deferred-tru "made {0} public" identifier)
[:enable_embedding false true]
(deferred-tru "enabled embedding")
[:enable_embedding true false]
(deferred-tru "disabled embedding")
[:parameters _ _]
(deferred-tru "changed the filters")
[:embedding_params _ _]
(deferred-tru "changed the embedding parameters")
[:archived _ after]
(if after
(deferred-tru "archived {0}" identifier)
(deferred-tru "unarchived {0}" identifier))
[:collection_position _ _]
(deferred-tru "changed pin position")
[:collection_id nil coll-id]
(deferred-tru "moved {0} to {1}" identifier (if coll-id
(t2/select-one-fn :name 'Collection coll-id)
(deferred-tru "Our analytics")))
[:collection_id (prev-coll-id :guard int?) coll-id]
(deferred-tru "moved {0} from {1} to {2}"
identifier
(t2/select-one-fn :name 'Collection prev-coll-id)
(if coll-id
(t2/select-one-fn :name 'Collection coll-id)
(deferred-tru "Our analytics")))
[:visualization_settings _ _]
(deferred-tru "changed the visualization settings")
;; Card specific
[:parameter_mappings _ _]
(deferred-tru "changed the filter mapping")
[:collection_preview _ after]
(if after
(deferred-tru "enabled collection review")
(deferred-tru "disabled collection preview"))
[:dataset_query _ _]
(deferred-tru "modified the query")
[:dataset false true]
(deferred-tru "turned this into a model")
[:dataset true false]
(deferred-tru "changed this from a model to a saved question")
[:display _ _]
(deferred-tru "changed the display from {0} to {1}" (name v1) (name v2))
[:result_metadata _ _]
(deferred-tru "edited the metadata")
;; whenever database_id, query_type, table_id changed,
;; the dataset_query will changed so we don't need a description for this
[#{:table_id :database_id :query_type} _ _]
nil
:else nil)) | |
Join parts of a sentence together to build a compound one. | (defn build-sentence
[parts]
(when (seq parts)
(cond
(= (count parts) 1) (str (first parts) \.)
(= (count parts) 2) (str (first parts) " " (deferred-tru "and") " " (second parts) \.)
:else (str (first parts) ", " (build-sentence (rest parts)))))) |
(defn ^:private model-str->i18n-str
[model-str]
(case model-str
"Dashboard" (deferred-tru "Dashboard")
"Card" (deferred-tru "Card")
"Segment" (deferred-tru "Segment")
"Metric" (deferred-tru "Metric"))) | |
Create a seq of string describing how | (defn diff-strings*
[model o1 o2]
(when-let [[before after] (data/diff o1 o2)]
(let [ks (keys (or after before))
model-name (model-str->i18n-str model)]
(loop [ks ks
identifier-count 0
strings []]
(if-not (seq ks)
strings
(let [k (first ks)
identifier (if (zero? identifier-count) (deferred-tru "this {0}" model-name) (deferred-tru "it"))]
(if-let [diff-str (diff-string k (k before) (k after) identifier)]
(recur (rest ks) (inc identifier-count) (conj strings diff-str))
(recur (rest ks) identifier-count strings)))))))) |
A namespace to handle getting the last edited information about items that satisfy the revision system. The revision
system is a 'reversion' system, built to easily revert to previous states and can compute on demand a changelog. The
revision system works through events and so when editing something, you should construct the last-edit-info
yourself (using This constructs | (ns metabase.models.revision.last-edit (:require [clj-time.core :as time] [clojure.set :as set] [medley.core :as m] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [steffan-westcott.clj-otel.api.trace.span :as span] [toucan2.core :as t2])) |
(def ^:private model->db-model {:card "Card" :dashboard "Dashboard"}) | |
Schema of the these are all maybes as sometimes revisions don't exist, or users might be missing the names, etc | (def ^:private LastEditInfo [:map [:timestamp [:maybe :any]] [:id [:maybe ms/PositiveInt]] [:first_name [:maybe :string]] [:last_name [:maybe :string]] [:email [:maybe :string]]]) |
Spec for an item annotated with last-edit-info. Items are cards or dashboards. Optional because we may not always have revision history for all cards/dashboards. | (def MaybeAnnotated
[:map
[:last-edit-info {:optional true} LastEditInfo]]) |
(mu/defn with-last-edit-info :- MaybeAnnotated
"Add the last edited information to a card. Will add a key `:last-edit-info`. Model should be one of `:dashboard` or
`:card`. Gets the last edited information from the revisions table. If you need this information from a put route,
use `@api/*current-user*` and a current timestamp since revisions are events and asynchronous."
[{:keys [id] :as item} model :- [:enum :dashboard :card]]
(span/with-span!
{:name "with-last-edit-info"
:attributes {:item/id id}}
(if-let [updated-info (t2/query-one {:select [:u.id :u.email :u.first_name :u.last_name :r.timestamp]
:from [[:revision :r]]
:left-join [[:core_user :u] [:= :u.id :r.user_id]]
:where [:and
[:= :r.most_recent true]
[:= :r.model (model->db-model model)]
[:= :r.model_id id]]})]
(assoc item :last-edit-info updated-info)
item))) | |
(mu/defn edit-information-for-user :- LastEditInfo
"Construct the `:last-edit-info` map given a user. Useful for editing routes. Most edit info information comes from
the revisions table. But this table is populated from events asynchronously so when editing and wanting
last-edit-info, you must construct it from `@api/*current-user*` and the current timestamp rather than checking the
revisions table as those revisions may not be present yet."
[user]
(merge {:timestamp (time/now)}
(select-keys user [:id :first_name :last_name :email]))) | |
Schema for the map of bulk last-item-info. A map of two keys, | (def ^:private CollectionLastEditInfo
[:map
[:card {:optional true} [:map-of :int LastEditInfo]]
[:dashboard {:optional true} [:map-of :int LastEditInfo]]]) |
(mu/defn fetch-last-edited-info :- [:maybe CollectionLastEditInfo]
"Fetch edited info from the revisions table. Revision information is timestamp, user id, email, first and last
name. Takes card-ids and dashboard-ids and returns a map structured like
{:card {card_id {:id :email :first_name :last_name :timestamp}}
:dashboard {dashboard_id {:id :email :first_name :last_name :timestamp}}}"
[{:keys [card-ids dashboard-ids]}]
(when (seq (concat card-ids dashboard-ids))
(let [latest-changes (t2/query {:select [:u.id :u.email :u.first_name :u.last_name
:r.model :r.model_id :r.timestamp]
:from [[:revision :r]]
:left-join [[:core_user :u] [:= :u.id :r.user_id]]
:where [:and [:= :r.most_recent true]
(into [:or]
(keep (fn [[model-name ids]]
(when (seq ids)
[:and [:= :model model-name] [:in :model_id ids]])))
[["Card" card-ids]
["Dashboard" dashboard-ids]])]})]
(->> latest-changes
(group-by :model)
(m/map-vals (fn [model-changes]
(into {} (map (juxt :model_id #(dissoc % :model :model_id))) model-changes)))
;; keys are "Card" and "Dashboard" (model in revision table) back to keywords
(m/map-keys (set/map-invert model->db-model)))))) | |
(ns metabase.models.secret (:require [clojure.core.memoize :as memoize] [clojure.java.io :as io] [clojure.string :as str] [java-time.api :as t] [metabase.api.common :as api] [metabase.driver :as driver] [metabase.driver.util :as driver.u] [metabase.models.interface :as mi] [metabase.public-settings.premium-features :as premium-features] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log] [methodical.core :as methodical] [toucan2.core :as t2]) (:import (java.io File) (java.nio.charset StandardCharsets))) | |
(set! *warn-on-reflection* true) | |
----------------------------------------------- Entity & Lifecycle ----------------------------------------------- | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase. | (def Secret :model/Secret) |
(methodical/defmethod t2/table-name :model/Secret [_model] :secret) | |
(doto Secret (derive :metabase/model) (derive :hook/timestamped?) (derive ::mi/read-policy.superuser) (derive ::mi/write-policy.superuser)) | |
(t2/deftransforms :model/Secret
{:value mi/transform-secret-value
:kind mi/transform-keyword
:source mi/transform-keyword}) | |
---------------------------------------------- Hydration / Util Fns ---------------------------------------------- | |
Returns the value of the given | (defn value->string
{:added "0.42.0"}
^String [{:keys [value] :as _secret}]
(cond (string? value)
value
(bytes? value)
(String. ^bytes value StandardCharsets/UTF_8))) |
For the given | (defn conn-props->secret-props-by-name
{:added "0.42.0"}
[conn-props]
(->> (filter #(= :secret (keyword (:type %))) conn-props)
(reduce (fn [acc prop] (assoc acc (:name prop) prop)) {}))) |
Returns the value of the given
| (defn value->file!*
{:added "0.42.0"}
(^File [secret]
(value->file!* secret nil))
(^File [secret driver?]
(value->file!* secret driver? nil))
(^File [{:keys [connection-property-name id value] :as secret} driver? ext?]
(if (= :file-path (:source secret))
(let [secret-val (value->string secret)
^File existing-file (File. secret-val)]
(if (.exists existing-file)
existing-file
(let [error-source (cond
id
(tru "Secret ID {0}" id)
(and connection-property-name driver?)
(let [secret-props (-> (driver/connection-properties driver?)
conn-props->secret-props-by-name)]
(tru "File path for {0}" (-> (get secret-props connection-property-name)
:display-name)))
:else
(tru "Path"))]
(throw (ex-info (tru "{0} points to non-existent file: {1}" error-source secret-val)
{:file-path secret-val
:secret secret})))))
(let [^File tmp-file (doto (File/createTempFile "metabase-secret_" ext?)
;; make the file only readable by owner
(.setReadable false false)
(.setReadable true true)
(.deleteOnExit))]
(log/tracef "Creating temp file for secret %s value at %s" (or id "") (.getAbsolutePath tmp-file))
(with-open [out (io/output-stream tmp-file)]
(let [^bytes v (cond
(string? value)
(.getBytes ^String value "UTF-8")
(bytes? value)
^bytes value)]
(.write out v)))
tmp-file)))) |
Returns the value of the given
| (def
^java.io.File
^{:arglists '([{:keys [connection-property-name id value] :as secret} & [driver? ext?]])}
value->file!
(memoize/memo
(with-meta value->file!*
{::memoize/args-fn (fn [[secret _driver? ext?]]
;; not clear if value->string could return nil due to the cond so we'll just cache on a key
;; that is unique
[(vec (:value secret)) ext?])}))) |
Return a map of secret subproperties for the property | (defn get-sub-props
[connection-property-name]
(let [sub-prop-types [:path :value :options :id]
sub-prop #(keyword (str connection-property-name "-" (name %)))]
(zipmap sub-prop-types (map sub-prop sub-prop-types)))) |
Regex for parsing base64 encoded file uploads. | (def uploaded-base-64-prefix-pattern #"^data:application/([^;]*);base64,") |
Returns the latest Secret instance for the given | (defn latest-for-id
{:added "0.42.0"}
[id]
(t2/select-one Secret :id id {:order-by [[:version :desc]]})) |
Returns a map containing This returned map represents a partial Secret model instance (having some of the required properties set), but also
represents a discrete property that can be used in connection testing (even without the Secret needing to be
persisted). In addition to possibly having
| (defn db-details-prop->secret-map
{:added "0.42.0"}
[details conn-prop-nm]
(let [{path-kw :path, value-kw :value, options-kw :options, id-kw :id}
(get-sub-props conn-prop-nm)
value (cond
;; ssl-root-certs will need their prefix removed, and to be base 64 decoded (#20319)
(and (value-kw details) (#{"ssl-client-cert" "ssl-root-cert"} conn-prop-nm)
(re-find uploaded-base-64-prefix-pattern (value-kw details)))
(-> (value-kw details) (str/replace-first uploaded-base-64-prefix-pattern "") u/decode-base64)
(and (value-kw details) (#{"ssl-key"} conn-prop-nm)
(re-find uploaded-base-64-prefix-pattern (value-kw details)))
(.decode (java.util.Base64/getDecoder)
(str/replace-first (value-kw details) uploaded-base-64-prefix-pattern ""))
;; the -value suffix was specified; use that
(value-kw details)
(value-kw details)
;; the -path suffix was specified; this is actually a :file-path
(path-kw details)
(u/prog1 (path-kw details)
(when (premium-features/is-hosted?)
(throw (ex-info
(tru "{0} (a local file path) cannot be used in Metabase hosted environment" path-kw)
{:invalid-db-details-entry (select-keys details [path-kw])}))))
(id-kw details)
(:value (latest-for-id (id-kw details))))
source (cond
;; set the :source due to the -path suffix (see above))
(and (not= "uploaded" (options-kw details)) (path-kw details))
:file-path
(id-kw details)
(:source (latest-for-id (id-kw details))))]
(cond-> {:connection-property-name conn-prop-nm, :subprops [path-kw value-kw id-kw]}
value
(assoc :value value
:source source)))) |
Get the value of a secret property from the database details as a string. | (defn get-secret-string
[details secret-property]
(let [{path-kw :path, value-kw :value, options-kw :options, id-kw :id} (get-sub-props secret-property)
id (id-kw details)
;; When a secret is updated, we get both a new value as well as the ID of old secret.
value (or (when-let [value (value-kw details)]
(if (string? value)
value
(String. ^bytes value "UTF-8")))
(when id
(String. ^bytes (:value (latest-for-id id)) "UTF-8")))]
(case (options-kw details)
"uploaded" (try
;; When a secret is updated, the value has already been decoded
;; instead of checking if the string is base64 encoded, we just
;; try to decoded it and leave it as is if the attempt fails.
(String. ^bytes (driver.u/decode-uploaded value) "UTF-8")
(catch IllegalArgumentException _
value))
"local" (slurp (if id value (path-kw details)))
value))) |
The attributes of a secret which, if changed, will result in a version bump | (def
^{:doc :private true}
bump-version-keys
[:kind :source :value]) |
Inserts a new secret value, or updates an existing one, for the given parameters. * if there is no existing Secret instance, inserts with the given field values * if there is an existing latest Secret instance, and the value (or any of the supporting fields, like kind or source) has changed, then inserts a new version with the given parameters. * if there is an existing latest Secret instance, but none of the aforementioned fields changed, then update it | (defn upsert-secret-value!
{:added "0.42.0"}
[existing-id nm kind src value]
(let [insert-new (fn [id v]
(let [inserted (first (t2/insert-returning-instances! Secret (cond-> {:version v
:name nm
:kind kind
:source src
:value value
:creator_id api/*current-user-id*}
id
(assoc :id id))))]
;; Toucan doesn't support composite primary keys, so adding a new record with incremented
;; version for an existing ID won't return a result from t2/insert!, hence we may need to
;; manually select it here
(t2/select-one Secret :id (or id (u/the-id inserted)) :version v)))
latest-version (when existing-id (latest-for-id existing-id))]
(if latest-version
(if (= (select-keys latest-version bump-version-keys) [kind src value])
(pos? (t2/update! Secret {:id existing-id :version (:version latest-version)}
{:name nm}))
(insert-new (u/the-id latest-version) (inc (:version latest-version))))
(insert-new nil 1)))) |
Reduces over the given
In essence, this is a utility function to provide a generic mechanism for transforming db-details containing secret values. | (defn reduce-over-details-secret-values
{:added "0.42.0"}
[driver db-details reduce-fn]
(let [conn-props-fn (get-method driver/connection-properties driver)]
(if (and (map? db-details) (fn? conn-props-fn))
(let [conn-props (conn-props-fn driver)
conn-secrets-by-name (conn-props->secret-props-by-name conn-props)]
(reduce-kv reduce-fn db-details conn-secrets-by-name))
db-details))) |
Expand certain secret sub-properties in the
The keys/value pairs that may be added into
| (defn expand-inferred-secret-values
{:added "0.42.0"}
[db-details conn-prop-nm _conn-prop & [secret-or-id]]
(let [subprop (fn [prop-nm]
(keyword (str conn-prop-nm prop-nm)))
secret* (cond (int? secret-or-id)
(latest-for-id secret-or-id)
(mi/instance-of? Secret secret-or-id)
secret-or-id
:else ; default; app DB look up from the ID in db-details
(latest-for-id (get db-details (subprop "-id"))))
src (:source secret*)]
;; always populate the -source, -creator-id, and -created-at sub properties
(cond-> (assoc db-details (subprop "-source") src
(subprop "-creator-id") (:creator_id secret*))
(some? (:created_at secret*))
(assoc (subprop "-created-at") (t/format :iso-offset-date-time (:created_at secret*)))
(= :file-path src) ; for file path sources only, populate the value
(assoc (subprop "-value") (value->string secret*))))) |
Expand certain inferred secret sub-properties in the | (defn expand-db-details-inferred-secret-values
{:added "0.42.0"}
[database]
(update database :details (fn [details]
(reduce-over-details-secret-values (driver.u/database->driver database)
details
expand-inferred-secret-values)))) |
(methodical/defmethod mi/to-json Secret "Never include the secret value in JSON." [secret json-generator] (next-method (dissoc secret :value) json-generator)) | |
A Segment is a saved MBQL 'macro', expanding to a | (ns metabase.models.segment (:require [clojure.set :as set] [medley.core :as m] [metabase.lib.core :as lib] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.jvm :as lib.metadata.jvm] [metabase.lib.metadata.protocols :as lib.metadata.protocols] [metabase.lib.query :as lib.query] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.id :as lib.schema.id] [metabase.mbql.util :as mbql.u] [metabase.models.audit-log :as audit-log] [metabase.models.interface :as mi] [metabase.models.revision :as revision] [metabase.models.serialization :as serdes] [metabase.models.table :as table] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [methodical.core :as methodical] [toucan2.core :as t2] [toucan2.tools.hydrate :as t2.hydrate])) |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase. | (def Segment :model/Segment) |
(methodical/defmethod t2/table-name :model/Segment [_model] :segment) (methodical/defmethod t2/model-for-automagic-hydration [:default :segment] [_original-model _k] :model/Segment) | |
(t2/deftransforms :model/Segment
{:definition mi/transform-metric-segment-definition}) | |
(doto :model/Segment (derive :metabase/model) (derive :hook/timestamped?) (derive :hook/entity-id) (derive ::mi/read-policy.full-perms-for-perms-set) (derive ::mi/write-policy.superuser) (derive ::mi/create-policy.superuser)) | |
(t2/define-before-update :model/Segment [{:keys [creator_id id], :as segment}]
(u/prog1 (t2/changes segment)
;; throw an Exception if someone tries to update creator_id
(when (contains? <> :creator_id)
(when (not= (:creator_id <>) (t2/select-one-fn :creator_id Segment :id id))
(throw (UnsupportedOperationException. (tru "You cannot update the creator_id of a Segment."))))))) | |
(defmethod mi/perms-objects-set Segment
[segment read-or-write]
(let [table (or (:table segment)
(t2/select-one ['Table :db_id :schema :id] :id (u/the-id (:table_id segment))))]
(mi/perms-objects-set table read-or-write))) | |
(mu/defn ^:private definition-description :- [:maybe ::lib.schema.common/non-blank-string]
"Calculate a nice description of a Segment's definition."
[metadata-provider :- lib.metadata/MetadataProvider
{table-id :table_id, :keys [definition], :as _segment} :- (ms/InstanceOf :model/Segment)]
(when (seq definition)
(try
(let [definition (merge {:source-table table-id}
definition)
database-id (u/the-id (lib.metadata.protocols/database metadata-provider))
query (lib.query/query-from-legacy-inner-query metadata-provider database-id definition)]
(lib/describe-top-level-key query :filters))
(catch Throwable e
(log/error e (tru "Error calculating Segment description: {0}" (ex-message e)))
nil)))) | |
(mu/defn ^:private warmed-metadata-provider :- lib.metadata/MetadataProvider
[database-id :- ::lib.schema.id/database
segments :- [:maybe [:sequential (ms/InstanceOf :model/Segment)]]]
(let [metadata-provider (doto (lib.metadata.jvm/application-database-metadata-provider database-id)
(lib.metadata.protocols/store-metadatas!
:metadata/segment
(map #(lib.metadata.jvm/instance->metadata % :metadata/segment)
segments)))
field-ids (mbql.u/referenced-field-ids (map :definition segments))
fields (lib.metadata.protocols/bulk-metadata metadata-provider :metadata/column field-ids)
table-ids (into #{}
cat
[(map :table-id fields)
(map :table_id segments)])]
;; this is done for side effects
(lib.metadata.protocols/bulk-metadata metadata-provider :metadata/table table-ids)
metadata-provider)) | |
(mu/defn ^:private segments->table-id->warmed-metadata-provider :- fn?
[segments :- [:maybe [:sequential (ms/InstanceOf :model/Segment)]]]
(let [table-id->db-id (when-let [table-ids (not-empty (into #{} (map :table_id segments)))]
(t2/select-pk->fn :db_id :model/Table :id [:in table-ids]))
db-id->metadata-provider (memoize
(mu/fn db-id->warmed-metadata-provider :- lib.metadata/MetadataProvider
[database-id :- ::lib.schema.id/database]
(let [segments-for-db (filter (fn [segment]
(= (table-id->db-id (:table_id segment))
database-id))
segments)]
(warmed-metadata-provider database-id segments-for-db))))]
(mu/fn table-id->warmed-metadata-provider :- lib.metadata/MetadataProvider
[table-id :- ::lib.schema.id/table]
(-> table-id table-id->db-id db-id->metadata-provider)))) | |
(methodical/defmethod t2.hydrate/batched-hydrate [Segment :definition_description]
[_model _key segments]
(let [table-id->warmed-metadata-provider (segments->table-id->warmed-metadata-provider segments)]
(for [segment segments
:let [metadata-provider (table-id->warmed-metadata-provider (:table_id segment))]]
(assoc segment :definition_description (definition-description metadata-provider segment))))) | |
--------------------------------------------------- Revisions ---------------------------------------------------- | |
(defmethod revision/serialize-instance Segment [_model _id instance] (dissoc instance :created_at :updated_at)) | |
(defmethod revision/diff-map Segment
[model segment1 segment2]
(if-not segment1
;; this is the first version of the segment
(m/map-vals (fn [v] {:after v}) (select-keys segment2 [:name :description :definition]))
;; do our diff logic
(let [base-diff ((get-method revision/diff-map :default)
model
(select-keys segment1 [:name :description :definition])
(select-keys segment2 [:name :description :definition]))]
(cond-> (merge-with merge
(m/map-vals (fn [v] {:after v}) (:after base-diff))
(m/map-vals (fn [v] {:before v}) (:before base-diff)))
(or (get-in base-diff [:after :definition])
(get-in base-diff [:before :definition])) (assoc :definition {:before (get segment1 :definition)
:after (get segment2 :definition)}))))) | |
------------------------------------------------ Serialization --------------------------------------------------- | |
(defmethod serdes/hash-fields Segment [_segment] [:name (serdes/hydrated-hash :table) :created_at]) | |
(defmethod serdes/extract-one "Segment"
[_model-name _opts segment]
(-> (serdes/extract-one-basics "Segment" segment)
(update :table_id serdes/*export-table-fk*)
(update :creator_id serdes/*export-user*)
(update :definition serdes/export-mbql))) | |
(defmethod serdes/load-xform "Segment" [segment]
(-> segment
serdes/load-xform-basics
(update :table_id serdes/*import-table-fk*)
(update :creator_id serdes/*import-user*)
(update :definition serdes/import-mbql))) | |
(defmethod serdes/dependencies "Segment" [{:keys [definition table_id]}]
(into [] (set/union #{(serdes/table->path table_id)}
(serdes/mbql-deps definition)))) | |
(defmethod serdes/storage-path "Segment" [segment _ctx]
(let [{:keys [id label]} (-> segment serdes/path last)]
(-> segment
:table_id
serdes/table->path
serdes/storage-table-path-prefix
(concat ["segments" (serdes/storage-leaf-file-name id label)])))) | |
---------------------------------------------- Audit Log Table ---------------------------------------------------- | |
(defmethod audit-log/model-details :model/Segment
[metric _event-type]
(let [table-id (:table_id metric)
db-id (table/table-id->database-id table-id)]
(assoc
(select-keys metric [:name :description :revision_message])
:table_id table-id
:database_id db-id))) | |
Defines several helper functions and multimethods for the serialization system. Serialization is an enterprise feature, but in the interest of keeping all the code for an entity in one place, these methods are defined here and implemented for all the exported models. Whether to export a new model: - Generally, the high-profile user facing things (databases, questions, dashboards, snippets, etc.) are exported. - Internal or automatic things (users, activity logs, permissions) are not. If the model is not exported, add it to the exclusion lists in the tests. Every model should be explicitly listed as exported or not, and a test enforces this so serialization isn't forgotten for new models. | (ns metabase.models.serialization (:refer-clojure :exclude [descendants]) (:require [cheshire.core :as json] [clojure.core.match :refer [match]] [clojure.set :as set] [clojure.string :as str] [medley.core :as m] [metabase.db.connection :as mdb.connection] [metabase.lib.schema.id :as lib.schema.id] [metabase.mbql.normalize :as mbql.normalize] [metabase.mbql.util :as mbql.u] [metabase.models.interface :as mi] [metabase.shared.models.visualization-settings :as mb.viz] [metabase.util :as u] [metabase.util.connection :as u.conn] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [toucan2.core :as t2] [toucan2.model :as t2.model])) |
(set! *warn-on-reflection* true) | |
Serialization OverviewSerialization (or "serdes") is a system for exporting entities (Dashboards, Cards, Collections, etc.) from one Metabase instance to disk files, and later importing them into 1 or more separate Metabase instances. There are two versions of serdes, known as v1 and v2. v2 was built in late 2022 to solve some problems with v1,
especially: accidentally duplicating entities because of a human change like renaming a collection; and that several
newly added models (eg. Timelines) were not added to serdes. v1's code is in There are tests which query the set of Toucan models and ensure that they either support serialization or are explicitly listed as exempt. Therefore serdes for new models is not forgotten. More detailsThis file is probably best not read top to bottom - it's organized in | |
Entity IDsEvery serializable entity needs the be identified in a way that is:
Database primary keys fail (3); matching based on the value fails (2) and maybe (1). So there's no easy way to solve this requirement. We've taken three approaches for different kinds of entities:
| |
Given the model name and an entity, returns its entity ID (which might be nil). This abstracts over the exact definition of the "entity ID" for a given entity.
By default this is a column, Models that have a different portable ID ( | (defmulti entity-id
{:arglists '([model-name instance])}
(fn [model-name _instance] model-name)) |
(defmethod entity-id :default [_ {:keys [entity_id]}]
(str/trim entity_id)) | |
Hashing entitiesIn the worst case, an entity is already present in two instances linked by serdes, and it doesn't have So every entity implements [[hash-fields]], which determines the set of fields whose values are used to generate the
hash. The 32-bit [[identity-hash]] is then used to seed the PRNG and generate a "random" NanoID. Since this is based
on properties of the entity, it is reproducible on both Before any Whoops, two kinds of backfillBraden discovered in Nov 2023 that for more than a year, we've had two inconsistent ways to backfill all the
Therefore the import machinery has to look out for both kinds of IDs and use them. This is foolish and should be
simplified. We should write a Clojure-powered migration that finds any short 8-character | |
Hashes a Clojure value into an 8-character hex string, which is used as the identity hash. Don't call this outside a test, use [[identity-hash]] instead. | (defn raw-hash
[target]
(when (sequential? target)
(assert (seq target) "target cannot be an empty sequence"))
(format "%08x" (hash target))) |
Returns a seq of functions which will be transformed into a seq of values for hash calculation by calling each function on an entity map. | (defmulti hash-fields
{:arglists '([model-or-instance])}
mi/dispatch-on-model) |
Returns an identity hash string (8 hex digits) from an This string is generated by:
- calling [[hash-fields]] for the model
- passing the | (defn identity-hash
[entity]
{:pre [(some? entity)]}
(-> (for [f (hash-fields entity)]
(f entity))
raw-hash)) |
Returns true if s is a valid identity hash string. | (defn identity-hash?
[s]
(boolean (re-matches #"^[0-9a-fA-F]{8}$" s))) |
Returns a function which accepts an entity and returns the identity hash of the value of the hydrated property under key k. This is a helper for writing [[hash-fields]] implementations. | (defn hydrated-hash
[k]
(fn [entity]
(or
(some-> entity (t2/hydrate k) (get k) identity-hash)
"<none>"))) |
Serdes paths and :serdes/metaThe Clojure maps from extraction and ingestion always include a special key Most paths are a single layer:
But for some entities, it can be deeper. For example, Fields belong to Tables, which are in Schemas, which are in Databases. (Schemas don't exist separately in the appdb, but they're used here to keep Table names unique.) For example:
Many of the serdes multimethods are keyed on the Two kinds of nestingTo reiterate, | |
Given the model name and raw entity from the database, returns a vector giving its path.
The path is a vector of maps, root first and this entity itself last. Each map looks like:
| (defmulti generate-path
{:arglists '([model-name instance])}
(fn [model-name _instance] model-name)) |
Returns | (defn infer-self-path
[model-name entity]
(let [model (t2.model/resolve-model (symbol model-name))
pk (first (t2/primary-keys model))]
{:model model-name
:id (or (entity-id model-name entity)
(some-> (get entity pk) model identity-hash))})) |
Common helper for defining [[generate-path]] for an entity that is (1) top-level, ie. a one layer path; (2) labeled by a single field, slugified. For example, a Card's or Dashboard's | (defn maybe-labeled
[model-name entity slug-key]
(let [self (infer-self-path model-name entity)
label (get entity slug-key)]
[(if label
(assoc self :label (u/slugify label {:unicode? true}))
self)])) |
(defmethod generate-path :default [model-name entity] ;; This default works for most models, but needs overriding for nested ones. (maybe-labeled model-name entity :name)) | |
Export ProcessAn export (writing a Metabase instance's entities to disk) happens in two stages: extraction and storage.
These are independent, and deliberately decoupled. The result of extraction is a reducible stream of Clojure maps,
each with Storage takes the stream of extracted entities and actually stores it to disk or sends it over the network. Traditionally we serialize to a directory of YAML files, and that's the only storage approach currently implemented. But since the export process is split into (complicated) extraction and (straightforward) storage, we or a user could write a new storage layer fairly easily if we wanted to use JSON, protocol buffers, or any other format. Both extraction and storage are written as a set of multimethods, with defaults for the common case. ExtractionExtraction is controlled by a map of options and settings, with details below.
The default [[extract-all]] works for nearly all models. Override [[extract-query]] if you need to control which
entities get serialized (eg. to exclude StorageStorage transforms the reducible stream in some arbitrary way. It returns nothing; storage is expected to have side effects like writing files to disk or transmitting them over the network. Not all storage implementations use directory structure, but for those that do [[storage-path]] should give the path
for an entity as a list of strings: By convention, models are named as plural and in lower case:
As a final remark, note that some entities have their own directories and some do not. For example, a Field is simply a file, while a Table has a directory. So a subset of the tree might look something like this:
Selective serializationIt's common to only export certain entities from an instance, rather than everything. We might export a single Question, or a Dashboard with all its DashboardCards and their Cards. There's a relation to be captured here: the descendants of an entity are the ones it semantically "contains", or those it needs in order to be executed. (As when a question depends on another, or a SQL question references a NativeQuerySnippet. [[descendants]] returns a set of such descendants for a given entity; see there for more details. Note: "descendants" and "dependencies" are quite different things! | |
Entry point for extracting all entities of a particular model:
Returns a reducible stream of extracted maps (ie. vanilla Clojure maps with You probably don't want to implement this directly. The default implementation delegates to [[extract-query]] and [[extract-one]], which are usually more convenient to override. | (defmulti extract-all
{:arglists '([model-name opts])}
(fn [model-name _opts] model-name)) |
Performs the select query, possibly filtered, for all the entities of this model that should be serialized. Called from [[extract-all]]'s default implementation.
Keyed on the model name, the first argument. Returns a reducible stream of modeled Toucan maps. Defaults to using You may want to override this to eg. skip archived entities, or otherwise filter what gets serialized. | (defmulti extract-query
{:arglists '([model-name opts])}
(fn [model-name _opts] model-name)) |
Extracts a single entity retrieved from the database into a portable map with The default implementation uses [[generate-path]] to build the That suffices for a few simple entities, but most entities will need to override this.
They should follow the pattern of:
- Convert to a vanilla Clojure map, not a modeled Toucan 2 entity.
- Drop the numeric database primary key (usually When overriding this, [[extract-one-basics]] is probably a useful starting point. Keyed by the model name of the entity, the first argument. | (defmulti extract-one
{:arglists '([model-name opts instance])}
(fn [model-name _opts _instance] model-name)) |
(defn- log-and-extract-one
[model opts instance]
(log/info (trs "Extracting {0} {1}" model (:id instance)))
(extract-one model opts instance)) | |
(defmethod extract-all :default [model opts]
(eduction (map (partial log-and-extract-one model opts))
(extract-query model opts))) | |
Helper for the common (but not default) [[extract-query]] case of fetching everything that isn't in a personal collection. | (defn extract-query-collections
[model {:keys [collection-set]}]
(if collection-set
;; If collection-set is defined, select everything in those collections, or with nil :collection_id.
(let [in-colls (t2/reducible-select model :collection_id [:in collection-set])]
(if (contains? collection-set nil)
(eduction cat [in-colls (t2/reducible-select model :collection_id nil)])
in-colls))
;; If collection-set is nil, just select everything.
(t2/reducible-select model))) |
(defmethod extract-query :default [model-name _] (t2/reducible-select (symbol model-name))) | |
A helper for writing [[extract-one]] implementations. It takes care of the basics:
- Convert to a vanilla Clojure map.
- Add Returns the Clojure map. | (defn extract-one-basics
[model-name entity]
(let [model (t2.model/resolve-model (symbol model-name))
pk (first (t2/primary-keys model))]
(-> (into {} entity)
(m/update-existing :entity_id str/trim)
(assoc :serdes/meta (generate-path model-name entity))
(dissoc pk :updated_at)))) |
(defmethod extract-one :default [model-name _opts entity] (extract-one-basics model-name entity)) | |
Returns set of Dispatched on model-name. | (defmulti descendants
{:arglists '([model-name db-id])}
(fn [model-name _] model-name)) |
(defmethod descendants :default [_ _] nil) | |
Return set of Dispatched on model-name. | (defmulti ascendants
{:arglists '([model-name db-id])}
(fn [model-name _] model-name)) |
(defmethod ascendants :default [_ _] nil) | |
Import ProcessDeserialization is split into two stages, mirroring serialization. They are called ingestion and loading.
Ingestion turns whatever serialized form was produced by storage (eg. a tree of YAML files) into Clojure maps with
IngestionIngestion is intended to be a black box, like storage above. [[metabase-enterprise.serialization.v2.ingest/Ingestable]] is defined as a protocol to allow easy [[reify]] usage for testing deserialization in memory. Factory functions consume some details (like a path to the export) and return an
This two-stage design avoids needing all the data in memory at once. (Assuming the underlying storage media is something like files, and not a network stream that won't wait!) LoadingLoading tries to find, for each ingested entity, a corresponding entity in the destination appdb, using the entity
IDs. If it finds a match, that row will be The entry point is [[metabase-enterprise.serialization.v2.load/load-metabase]]. First,
Both | |
The dispatch function for several of the load multimethods: dispatching on the model of the incoming entity. | (defn- ingested-model [ingested] (-> ingested :serdes/meta last :model)) |
Given an exported or imported entity with a | (defn path [entity] (:serdes/meta entity)) |
Given a path, tries to look up any corresponding local entity. Returns nil, or the local Toucan entity that corresponds to the given path. Keyed on the model name at the leaf of the path. By default, this tries to look up the entity by its | (defmulti load-find-local
{:arglists '([path])}
(fn [path]
(-> path last :model))) |
(declare lookup-by-id) | |
(defmethod load-find-local :default [path]
(let [{id :id model-name :model} (last path)
model (t2.model/resolve-model (symbol model-name))]
(when model
(lookup-by-id model id)))) | |
DependenciesThe files of an export are returned in arbitrary order by [[ingest-list]]. But in order to load any entity, everything it has a foreign key to must be loaded first. This is the purpose of one of the most complicated parts of serdes: [[dependencies]]. This multimethod returns a list (possibly empty) of Think carefully about the dependencies of any model. Do they have optional fields that sometimes have FKs?
Eg. a DashboardCard can contain custom | |
Given an entity map as ingested (not a Toucan entity) returns a (possibly empty) list of its dependencies, where each
dependency is represented by its abstract path (its Keyed on the model name for this entity. Default implementation returns an empty vector, so only models that have dependencies need to implement this. | (defmulti dependencies
{:arglists '([ingested])}
ingested-model) |
(defmethod dependencies :default [_] []) | |
Given the incoming vanilla map as ingested, transform it so it's suitable for sending to the database (in eg. [[t2/insert!]]). For example, this should convert any foreign keys back from a portable entity ID or identity hash into a numeric database ID. This is the mirror of [[extract-one]], in spirit. (They're not strictly inverses - [[extract-one]] drops the primary key but this need not put one back, for example.) By default, this just calls [[load-xform-basics]]. If you override this, call [[load-xform-basics]] as well. | (defmulti load-xform
{:arglists '([ingested])}
ingested-model) |
Given a table name, returns a map of columnname -> columntype | (def ^:private fields-for-table
(mdb.connection/memoize-for-application-db
(fn fields-for-table [table-name]
(u.conn/app-db-column-types mdb.connection/*application-db* table-name)))) |
Returns the table name that a particular ingested entity should finally be inserted into. | (defn- ->table-name [ingested] (->> ingested ingested-model (keyword "model") t2/table-name name)) |
Called by | (defmulti ingested-model-columns ingested-model) |
(defmethod ingested-model-columns :default
;; this works for most models - it just returns a set of keywordized column names from the database.
[ingested]
(->> ingested
->table-name
fields-for-table
keys
(map (comp keyword u/lower-case-en))
set)) | |
Given an ingested entity, removes keys that will not 'fit' into the current schema, because the column no longer exists. This can happen when serialization dumps generated on an earlier version of Metabase are loaded into a later version of Metabase, when a column gets removed. (At the time of writing I am seeing this happen with color on collections). | (defn- drop-excess-keys [ingested] (select-keys ingested (ingested-model-columns ingested))) |
Performs the usual steps for an incoming entity:
- removes extraneous keys (e.g. You should call this as part of any implementation of [[load-xform]]. This is a mirror (but not precise inverse) of [[extract-one-basics]]. | (defn load-xform-basics [ingested] (drop-excess-keys ingested)) |
(defmethod load-xform :default [ingested] (load-xform-basics ingested)) | |
Called by the default [[load-one!]] if there is a corresponding entity already in the appdb.
Defaults to a straightforward [[t2/update!]], and you may not need to update it. Keyed on the model name (the first argument), because the second argument doesn't have its Returns the updated entity. | (defmulti load-update!
{:arglists '([model-name ingested local])}
(fn [model _ _] model)) |
(defmethod load-update! :default [model-name ingested local]
(let [model (t2.model/resolve-model (symbol model-name))
pk (first (t2/primary-keys model))
id (get local pk)]
(log/tracef "Upserting %s %d: old %s new %s" model-name id (pr-str local) (pr-str ingested))
(t2/update! model id ingested)
(t2/select-one model pk id))) | |
Called by the default [[load-one!]] if there is no corresponding entity already in the appdb.
Defaults to a straightforward [[(comp first t2/insert-returning-instances!)]] (returning the created object), and you probably don't need to implement this. Note that any [[t2/insert!]] behavior we don't want to run (like generating an Keyed on the model name (the first argument), because the second argument doesn't have its Returns the newly inserted entity. | (defmulti load-insert!
{:arglists '([model ingested])}
(fn [model _] model)) |
(defmethod load-insert! :default [model-name ingested] (log/tracef "Inserting %s: %s" model-name (pr-str ingested)) (first (t2/insert-returning-instances! (t2.model/resolve-model (symbol model-name)) ingested))) | |
Black box for integrating a deserialized entity into this appdb.
Defaults to calling [[load-xform]] to massage the incoming map, then either [[load-update!]] if Prefer overriding [[load-xform]], and if necessary [[load-update!]] and [[load-insert!]], rather than this. Keyed on the model name. Returns the primary key of the updated or inserted entity. | (defmulti load-one!
(fn [ingested _]
(ingested-model ingested))) |
Default implementation of | (defn default-load-one!
[ingested maybe-local]
(let [model (ingested-model ingested)
adjusted (load-xform ingested)]
(binding [mi/*deserializing?* true]
(if (nil? maybe-local)
(load-insert! model adjusted)
(load-update! model adjusted maybe-local))))) |
(defmethod load-one! :default [ingested maybe-local] (default-load-one! ingested maybe-local)) | |
Checks if the given string is a 21-character NanoID. Useful for telling entity IDs apart from identity hashes. | (defn entity-id?
[id-str]
(boolean (and id-str
(string? id-str)
(re-matches #"^[A-Za-z0-9_-]{21}$" id-str)))) |
Given a model and a target identity hash, this scans the appdb for any instance of the model corresponding to the hash. Does a complete scan, so this should be called sparingly! TODO: Clean up this [[identity-hash]] infrastructure once the | (defn- find-by-identity-hash
;; TODO This should be able to use a cache of identity-hash values from the start of the deserialization process.
;; Note that it needs to include either updates (or worst-case, invalidation) at [[load-one!]] time.
[model id-hash]
(->> (t2/reducible-select model)
(into [] (comp (filter #(= id-hash (identity-hash %)))
(take 1)))
first)) |
Given an ID string, this endeavours to find the matching entity, whether it's an entity ID or identity hash. This is useful when writing [[load-xform]] to turn a foreign key from a portable form to an appdb ID. Returns a Toucan entity or nil. | (defn lookup-by-id
[model id-str]
(if (entity-id? id-str)
(t2/select-one model :entity_id id-str)
(find-by-identity-hash model id-str))) |
(def ^:private max-label-length 100) | |
(defn- truncate-label [s]
(if (> (count s) max-label-length)
(subs s 0 max-label-length)
s)) | |
(defn- lower-plural [s] (-> s u/lower-case-en (str "s"))) | |
Captures the common pattern for leaf file names as | (defn storage-leaf-file-name
([id] (str id))
([id label] (if (nil? label)
(storage-leaf-file-name id)
(str id "_" (truncate-label label))))) |
Implements the most common structure for [[storage-path]] - | (defn storage-default-collection-path
[entity {:keys [collections]}]
(let [{:keys [model id label]} (-> entity path last)]
(concat ["collections"]
(get collections (:collection_id entity)) ;; This can be nil, but that's fine - that's the root collection.
[(lower-plural model) (storage-leaf-file-name id label)]))) |
Returns a seq of storage path components for a given entity. Dispatches on model name. | (defmulti storage-path
{:arglists '([entity ctx])}
(fn [entity _] (ingested-model entity))) |
(defmethod storage-path :default [entity ctx] (storage-default-collection-path entity ctx)) | |
Creates the basic context for storage. This is a map with a single entry: | (defn storage-base-context
[]
(let [colls (t2/select ['Collection :id :entity_id :location :slug])
coll-names (into {} (for [{:keys [id entity_id slug]} colls]
[(str id) (storage-leaf-file-name entity_id slug)]))
coll->path (into {} (for [{:keys [entity_id id location]} colls
:let [parents (rest (str/split location #"/"))]]
[entity_id (map coll-names (concat parents [(str id)]))]))]
{:collections coll->path})) |
Returns a string for logging from a serdes path sequence (i.e. in :serdes/meta) | (defn log-path-str
[elements]
(->> elements
(map #(str (:model %) " " (:id %)))
(str/join " > "))) |
Utilities for implementing serdesNote that many of these use | |
General foreign keys | |
Given a numeric foreign key and its model (symbol, name or IModel), looks up the entity by ID and gets its entity ID
or identity hash.
Unusual parameter order means this can be used as NOTE: This works for both top-level and nested entities. Top-level entities like | (defn ^:dynamic ^::cache *export-fk*
[id model]
(when id
(let [model-name (name model)
model (t2.model/resolve-model (symbol model-name))
entity (t2/select-one model (first (t2/primary-keys model)) id)
path (mapv :id (generate-path model-name entity))]
(if (= (count path) 1)
(first path)
path)))) |
Given an identifier, and the model it represents (symbol, name or IModel), looks up the corresponding entity and gets its primary key. The identifier can be a single entity ID string, a single identity-hash string, or a vector of entity ID and hash
strings. If the ID is compound, then the last ID is the one that corresponds to the model. This allows for the
compound IDs needed for nested entities like Throws if the corresponding entity cannot be found. Unusual parameter order means this can be used as | (defn ^:dynamic ^::cache *import-fk*
[eid model]
(when eid
(let [model-name (name model)
model (t2.model/resolve-model (symbol model-name))
eid (if (vector? eid)
(last eid)
eid)
entity (lookup-by-id model eid)]
(if entity
(get entity (first (t2/primary-keys model)))
(throw (ex-info "Could not find foreign key target - bad serdes dependencies or other serialization error"
{:entity_id eid :model (name model)})))))) |
Given a numeric ID, look up a different identifying field for that entity, and return it as a portable ID.
Eg. Note: This assumes the primary key is called | (defn ^:dynamic ^::cache *export-fk-keyed* [id model field] (t2/select-one-fn field model :id id)) |
Given a single, portable, identifying field and the model it refers to, this resolves the entity and returns its
numeric Unusual parameter order lets this be called as, for example,
| (defn ^:dynamic ^::cache *import-fk-keyed* [portable model field] (t2/select-one-pk model field portable)) |
Exports a user as the email address. This just calls [[export-fk-keyed]], but the counterpart [[import-user]] is more involved. This is a unique function so they form a pair. Users | (defn ^:dynamic ^::cache *export-user* [id] (when id (*export-fk-keyed* id 'User :email))) |
Imports a user by their email address. If a user with that email address exists, returns its primary key. If no such user exists, creates a dummy one with the default settings, blank name, and randomized password. Does not send any invite emails. | (defn ^:dynamic ^::cache *import-user*
[email]
(when email
(or (*import-fk-keyed* email 'User :email)
;; Need to break a circular dependency here.
(:id ((resolve 'metabase.models.user/serdes-synthesize-user!) {:email email}))))) |
Tables | |
Given a numeric | (defn ^:dynamic ^::cache *export-table-fk*
[table-id]
(when table-id
(let [{:keys [db_id name schema]} (t2/select-one 'Table :id table-id)
db-name (t2/select-one-fn :name 'Database :id db_id)]
[db-name schema name]))) |
Given a | (defn ^:dynamic ^::cache *import-table-fk*
[[db-name schema table-name :as table-id]]
(when table-id
(t2/select-one-fn :id 'Table :name table-name :schema schema :db_id (t2/select-one-fn :id 'Database :name db-name)))) |
Given a | (defn table->path
[[db-name schema table-name]]
(filterv some? [{:model "Database" :id db-name}
(when schema {:model "Schema" :id schema})
{:model "Table" :id table-name}])) |
The [[serdes/storage-path]] for Table is a bit tricky, and shared with Fields and FieldValues, so it's
factored out here.
Takes the :serdes/meta value for a With a schema: | (defn storage-table-path-prefix
[path]
(let [db-name (-> path first :id)
schema (when (= (count path) 3)
(-> path second :id))
table-name (-> path last :id)]
(concat ["databases" db-name]
(when schema ["schemas" schema])
["tables" table-name]))) |
Fields | |
Given a numeric | (defn ^:dynamic ^::cache *export-field-fk*
[field-id]
(when field-id
(let [{:keys [name table_id]} (t2/select-one 'Field :id field-id)
[db-name schema field-name] (*export-table-fk* table_id)]
[db-name schema field-name name]))) |
Given a | (defn ^:dynamic ^::cache *import-field-fk*
[[db-name schema table-name field-name :as field-id]]
(when field-id
(let [table_id (*import-table-fk* [db-name schema table-name])]
(t2/select-one-pk 'Field :table_id table_id :name field-name)))) |
Given a | (defn field->path
[[db-name schema table-name field-name]]
(filterv some? [{:model "Database" :id db-name}
(when schema {:model "Schema" :id schema})
{:model "Table" :id table-name}
{:model "Field" :id field-name}])) |
MBQL Fields | |
Is given form an MBQL entity reference? | (defn- mbql-entity-reference?
[form]
(mbql.normalize/is-clause? #{:field :field-id :fk-> :dimension :metric :segment} form)) |
(defn- mbql-id->fully-qualified-name
[mbql]
(-> mbql
mbql.normalize/normalize-tokens
(mbql.u/replace
;; `integer?` guard is here to make the operation idempotent
[:field (id :guard integer?) opts]
[:field (*export-field-fk* id) (mbql-id->fully-qualified-name opts)]
;; `integer?` guard is here to make the operation idempotent
[:field (id :guard integer?)]
[:field (*export-field-fk* id)]
;; field-id is still used within parameter mapping dimensions
;; example relevant clause - [:dimension [:fk-> [:field-id 1] [:field-id 2]]]
[:field-id (id :guard integer?)]
[:field-id (*export-field-fk* id)]
{:source-table (id :guard integer?)}
(assoc &match :source-table (*export-table-fk* id))
;; source-field is also used within parameter mapping dimensions
;; example relevant clause - [:field 2 {:source-field 1}]
{:source-field (id :guard integer?)}
(assoc &match :source-field (*export-field-fk* id))
[:dimension (dim :guard vector?)]
[:dimension (mbql-id->fully-qualified-name dim)]
[:metric (id :guard integer?)]
[:metric (*export-fk* id 'Metric)]
[:segment (id :guard integer?)]
[:segment (*export-fk* id 'Segment)]))) | |
(defn- export-source-table
[source-table]
(if (and (string? source-table)
(str/starts-with? source-table "card__"))
(*export-fk* (-> source-table
(str/split #"__")
second
Integer/parseInt)
'Card)
(*export-table-fk* source-table))) | |
(defn- ids->fully-qualified-names
[entity]
(mbql.u/replace entity
mbql-entity-reference?
(mbql-id->fully-qualified-name &match)
sequential?
(mapv ids->fully-qualified-names &match)
map?
(as-> &match entity
(m/update-existing entity :database (fn [db-id]
(if (= db-id lib.schema.id/saved-questions-virtual-database-id)
"database/__virtual"
(t2/select-one-fn :name 'Database :id db-id))))
(m/update-existing entity :card_id #(*export-fk* % 'Card)) ; attibutes that refer to db fields use _
(m/update-existing entity :card-id #(*export-fk* % 'Card)) ; template-tags use dash
(m/update-existing entity :source-table export-source-table)
(m/update-existing entity :source_table export-source-table)
(m/update-existing entity :breakout (fn [breakout]
(mapv mbql-id->fully-qualified-name breakout)))
(m/update-existing entity :aggregation (fn [aggregation]
(mapv mbql-id->fully-qualified-name aggregation)))
(m/update-existing entity :filter ids->fully-qualified-names)
(m/update-existing entity ::mb.viz/param-mapping-source *export-field-fk*)
(m/update-existing entity :segment *export-fk* 'Segment)
(m/update-existing entity :snippet-id *export-fk* 'NativeQuerySnippet)
(merge entity
(m/map-vals ids->fully-qualified-names
(dissoc entity
:database :card_id :card-id :source-table :breakout :aggregation :filter :segment
::mb.viz/param-mapping-source :snippet-id)))))) | |
Given an MBQL expression, convert it to an EDN structure and turn the non-portable Database, Table and Field IDs inside it into portable references. | (defn export-mbql [encoded] (ids->fully-qualified-names encoded)) |
True if the provided string is either an Entity ID or identity-hash string. | (defn- portable-id?
[s]
(and (string? s)
(or (entity-id? s)
(identity-hash? s)))) |
(defn- mbql-fully-qualified-names->ids*
[entity]
(mbql.u/replace entity
;; handle legacy `:field-id` forms encoded prior to 0.39.0
;; and also *current* expresion forms used in parameter mapping dimensions
;; example relevant clause - [:dimension [:fk-> [:field-id 1] [:field-id 2]]]
[(:or :field-id "field-id") fully-qualified-name]
(mbql-fully-qualified-names->ids* [:field fully-qualified-name])
[(:or :field "field") (fully-qualified-name :guard vector?) opts]
[:field (*import-field-fk* fully-qualified-name) (mbql-fully-qualified-names->ids* opts)]
[(:or :field "field") (fully-qualified-name :guard vector?)]
[:field (*import-field-fk* fully-qualified-name)]
;; source-field is also used within parameter mapping dimensions
;; example relevant clause - [:field 2 {:source-field 1}]
{:source-field (fully-qualified-name :guard vector?)}
(assoc &match :source-field (*import-field-fk* fully-qualified-name))
{:database (fully-qualified-name :guard string?)}
(-> &match
(assoc :database (if (= fully-qualified-name "database/__virtual")
lib.schema.id/saved-questions-virtual-database-id
(t2/select-one-pk 'Database :name fully-qualified-name)))
mbql-fully-qualified-names->ids*) ; Process other keys
{:card-id (entity-id :guard portable-id?)}
(-> &match
(assoc :card-id (*import-fk* entity-id 'Card))
mbql-fully-qualified-names->ids*) ; Process other keys
[(:or :metric "metric") (fully-qualified-name :guard portable-id?)]
[:metric (*import-fk* fully-qualified-name 'Metric)]
[(:or :segment "segment") (fully-qualified-name :guard portable-id?)]
[:segment (*import-fk* fully-qualified-name 'Segment)]
(_ :guard (every-pred map? #(vector? (:source-table %))))
(-> &match
(assoc :source-table (*import-table-fk* (:source-table &match)))
mbql-fully-qualified-names->ids*)
(_ :guard (every-pred map? #(vector? (:source_table %))))
(-> &match
(assoc :source_table (*import-table-fk* (:source_table &match)))
mbql-fully-qualified-names->ids*)
(_ :guard (every-pred map? (comp portable-id? :source-table)))
(-> &match
(assoc :source-table (str "card__" (*import-fk* (:source-table &match) 'Card)))
mbql-fully-qualified-names->ids*)
(_ :guard (every-pred map? (comp portable-id? :source_table)))
(-> &match
(assoc :source_table (str "card__" (*import-fk* (:source_table &match) 'Card)))
mbql-fully-qualified-names->ids*) ;; process other keys
(_ :guard (every-pred map? (comp portable-id? :snippet-id)))
(-> &match
(assoc :snippet-id (*import-fk* (:snippet-id &match) 'NativeQuerySnippet))
mbql-fully-qualified-names->ids*))) | |
(defn- mbql-fully-qualified-names->ids [entity] (mbql-fully-qualified-names->ids* entity)) | |
Given an MBQL expression as an EDN structure with portable IDs embedded, convert the IDs back to raw numeric IDs. | (defn import-mbql [exported] (mbql-fully-qualified-names->ids exported)) |
(declare ^:private mbql-deps-map) | |
(defn- mbql-deps-vector [entity]
(match entity
[:field (field :guard vector?)] #{(field->path field)}
["field" (field :guard vector?)] #{(field->path field)}
[:field-id (field :guard vector?)] #{(field->path field)}
["field-id" (field :guard vector?)] #{(field->path field)}
[:field (field :guard vector?) tail] (into #{(field->path field)} (mbql-deps-map tail))
["field" (field :guard vector?) tail] (into #{(field->path field)} (mbql-deps-map tail))
[:field-id (field :guard vector?) tail] (into #{(field->path field)} (mbql-deps-map tail))
["field-id" (field :guard vector?) tail] (into #{(field->path field)} (mbql-deps-map tail))
[:metric (field :guard portable-id?)] #{[{:model "Metric" :id field}]}
["metric" (field :guard portable-id?)] #{[{:model "Metric" :id field}]}
[:segment (field :guard portable-id?)] #{[{:model "Segment" :id field}]}
["segment" (field :guard portable-id?)] #{[{:model "Segment" :id field}]}
:else (reduce #(cond
(map? %2) (into %1 (mbql-deps-map %2))
(vector? %2) (into %1 (mbql-deps-vector %2))
:else %1)
#{}
entity))) | |
(defn- mbql-deps-map [entity]
(->> (for [[k v] entity]
(cond
(and (= k :database)
(string? v)
(not= v "database/__virtual")) #{[{:model "Database" :id v}]}
(and (= k :source-table) (vector? v)) #{(table->path v)}
(and (= k :source-table) (portable-id? v)) #{[{:model "Card" :id v}]}
(and (= k :source-field) (vector? v)) #{(field->path v)}
(and (= k :snippet-id) (portable-id? v)) #{[{:model "NativeQuerySnippet" :id v}]}
(and (= k :card_id) (string? v)) #{[{:model "Card" :id v}]}
(and (= k :card-id) (string? v)) #{[{:model "Card" :id v}]}
(map? v) (mbql-deps-map v)
(vector? v) (mbql-deps-vector v)))
(reduce set/union #{}))) | |
Given an MBQL expression as exported, with qualified names like | (defn mbql-deps
[entity]
(cond
(map? entity) (mbql-deps-map entity)
(seqable? entity) (mbql-deps-vector entity)
:else (mbql-deps-vector [entity]))) |
Dashboard/Question Parameters | |
(defn- export-parameter-mapping [mapping] (ids->fully-qualified-names mapping)) | |
Given the :parameter_mappings field of a | (defn export-parameter-mappings [mappings] (map export-parameter-mapping mappings)) |
Given the :parameter_mappings field as exported by serialization convert its field references
( | (defn import-parameter-mappings
[mappings]
(->> mappings
(map mbql-fully-qualified-names->ids)
(map #(m/update-existing % :card_id *import-fk* 'Card)))) |
Given the :parameter field of a | (defn export-parameters [parameters] (map ids->fully-qualified-names parameters)) |
Given the :parameter field as exported by serialization convert its field references
( | (defn import-parameters
[parameters]
(for [param parameters]
(-> param
mbql-fully-qualified-names->ids
(m/update-existing-in [:values_source_config :card_id] *import-fk* 'Card)))) |
Given the :parameters (possibly nil) for an entity, return any embedded serdes-deps as a set. Always returns an empty set even if the input is nil. | (defn parameters-deps
[parameters]
(reduce set/union #{}
(for [parameter parameters
:when (= "card" (:values_source_type parameter))
:let [config (:values_source_config parameter)]]
(set/union #{[{:model "Card" :id (:card_id config)}]}
(mbql-deps-vector (:value_field config)))))) |
Viz settings | |
A map from model on linkcards to its corresponding toucan model. Link cards are dashcards that link to internal entities like Database/Dashboard/... or an url. It's here instead of [[metabase.models.dashboard-card]] to avoid cyclic deps. | (def link-card-model->toucan-model
{"card" :model/Card
"dataset" :model/Card
"collection" :model/Collection
"database" :model/Database
"dashboard" :model/Dashboard
"question" :model/Card
"table" :model/Table}) |
(defn- export-viz-link-card
[settings]
(m/update-existing-in
settings
[:link :entity]
(fn [{:keys [id model] :as entity}]
(merge entity
{:id (case model
"table" (*export-table-fk* id)
"database" (*export-fk-keyed* id 'Database :name)
(*export-fk* id (link-card-model->toucan-model model)))})))) | |
Converts IDs to fully qualified names inside a JSON string. Returns a new JSON string with the IDs converted inside. | (defn- json-ids->fully-qualified-names
[json-str]
(-> json-str
(json/parse-string true)
ids->fully-qualified-names
json/generate-string)) |
Converts fully qualified names to IDs in MBQL embedded inside a JSON string. Returns a new JSON string with teh IDs converted inside. | (defn- json-mbql-fully-qualified-names->ids
[json-str]
(-> json-str
(json/parse-string true)
mbql-fully-qualified-names->ids
json/generate-string)) |
(defn- export-viz-click-behavior-link
[{:keys [linkType type] :as click-behavior}]
(cond-> click-behavior
(= type "link") (update :targetId *export-fk* (link-card-model->toucan-model linkType)))) | |
(defn- import-viz-click-behavior-link
[{:keys [linkType type] :as click-behavior}]
(cond-> click-behavior
(= type "link") (update :targetId *import-fk* (link-card-model->toucan-model linkType)))) | |
(defn- export-viz-click-behavior-mapping [mapping]
(-> mapping
(m/update-existing :id json-ids->fully-qualified-names)
(m/update-existing-in [:target :id] json-ids->fully-qualified-names)
(m/update-existing-in [:target :dimension] ids->fully-qualified-names))) | |
(defn- import-viz-click-behavior-mapping [mapping]
(-> mapping
(m/update-existing :id json-mbql-fully-qualified-names->ids)
(m/update-existing-in [:target :id] json-mbql-fully-qualified-names->ids)
(m/update-existing-in [:target :dimension] mbql-fully-qualified-names->ids))) | |
The | (defn- export-viz-click-behavior-mappings
[mappings]
(into {} (for [[kw-key mapping] mappings
;; Mapping keyword shouldn't been a keyword in the first place, it's just how it's processed after
;; being selected from db. In an ideal world we'd either have different data layout for
;; click_behavior or not convert it's keys to a keywords. We need its full content here.
:let [k (u/qualified-name kw-key)]]
(if (mb.viz/dimension-param-mapping? mapping)
[(json-ids->fully-qualified-names k)
(export-viz-click-behavior-mapping mapping)]
[k mapping])))) |
The exported form of | (defn- import-viz-click-behavior-mappings
[mappings]
(into {} (for [[json-key mapping] mappings]
(if (mb.viz/dimension-param-mapping? mapping)
[(keyword (json-mbql-fully-qualified-names->ids json-key))
(import-viz-click-behavior-mapping mapping)]
[json-key mapping])))) |
(defn- export-viz-click-behavior [settings]
(some-> settings
(m/update-existing :click_behavior export-viz-click-behavior-link)
(m/update-existing-in [:click_behavior :parameterMapping] export-viz-click-behavior-mappings))) | |
(defn- import-viz-click-behavior [settings]
(some-> settings
(m/update-existing :click_behavior import-viz-click-behavior-link)
(m/update-existing-in [:click_behavior :parameterMapping] import-viz-click-behavior-mappings))) | |
(defn- export-pivot-table [settings]
(some-> settings
(m/update-existing-in [:pivot_table.column_split :rows] ids->fully-qualified-names)
(m/update-existing-in [:pivot_table.column_split :columns] ids->fully-qualified-names))) | |
(defn- import-pivot-table [settings]
(some-> settings
(m/update-existing-in [:pivot_table.column_split :rows] mbql-fully-qualified-names->ids)
(m/update-existing-in [:pivot_table.column_split :columns] mbql-fully-qualified-names->ids))) | |
(defn- export-visualizations [entity] (mbql.u/replace entity ["field-id" (id :guard number?)] ["field-id" (*export-field-fk* id)] [:field-id (id :guard number?)] [:field-id (*export-field-fk* id)] ["field-id" (id :guard number?) tail] ["field-id" (*export-field-fk* id) (export-visualizations tail)] [:field-id (id :guard number?) tail] [:field-id (*export-field-fk* id) (export-visualizations tail)] ["field" (id :guard number?)] ["field" (*export-field-fk* id)] [:field (id :guard number?)] [:field (*export-field-fk* id)] ["field" (id :guard number?) tail] ["field" (*export-field-fk* id) (export-visualizations tail)] [:field (id :guard number?) tail] [:field (*export-field-fk* id) (export-visualizations tail)] (_ :guard map?) (m/map-vals export-visualizations &match) (_ :guard vector?) (mapv export-visualizations &match))) | |
Column settings use a JSON-encoded string as a map key, and it contains field numbers. This function parses those keys, converts the IDs to portable values, and serializes them back to JSON. | (defn- export-column-settings
[settings]
(when settings
(-> settings
(update-keys #(-> % json/parse-string export-visualizations json/generate-string))
(update-vals export-viz-click-behavior)))) |
Given the | (defn export-visualization-settings
[settings]
(when settings
(-> settings
export-visualizations
export-viz-link-card
export-viz-click-behavior
export-pivot-table
(update :column_settings export-column-settings)))) |
(defn- import-viz-link-card
[settings]
(m/update-existing-in
settings
[:link :entity]
(fn [{:keys [id model] :as entity}]
(merge entity
{:id (case model
"table" (*import-table-fk* id)
"database" (*import-fk-keyed* id 'Database :name)
(*import-fk* id (link-card-model->toucan-model model)))})))) | |
(defn- import-visualizations [entity] (mbql.u/replace entity [(:or :field-id "field-id") (fully-qualified-name :guard vector?) tail] [:field-id (*import-field-fk* fully-qualified-name) (import-visualizations tail)] [(:or :field-id "field-id") (fully-qualified-name :guard vector?)] [:field-id (*import-field-fk* fully-qualified-name)] [(:or :field "field") (fully-qualified-name :guard vector?) tail] [:field (*import-field-fk* fully-qualified-name) (import-visualizations tail)] [(:or :field "field") (fully-qualified-name :guard vector?)] [:field (*import-field-fk* fully-qualified-name)] (_ :guard map?) (m/map-vals import-visualizations &match) (_ :guard vector?) (mapv import-visualizations &match))) | |
(defn- import-column-settings [settings]
(when settings
(-> settings
(update-keys #(-> % name json/parse-string import-visualizations json/generate-string))
(update-vals import-viz-click-behavior)))) | |
Given an EDN value as exported by [[export-visualization-settings]], convert its portable | (defn import-visualization-settings
[settings]
(when settings
(-> settings
import-visualizations
import-viz-link-card
import-viz-click-behavior
import-pivot-table
(update :column_settings import-column-settings)))) |
(defn- viz-link-card-deps
[settings]
(when-let [{:keys [model id]} (get-in settings [:link :entity])]
#{(case model
"table" (table->path id)
[{:model (name (link-card-model->toucan-model model))
:id id}])})) | |
(defn- viz-click-behavior-deps
[settings]
(when-let [{:keys [linkType targetId type]} (:click_behavior settings)]
(case type
"link" (when-let [model (some-> linkType link-card-model->toucan-model name)]
#{[{:model model
:id targetId}]})
;; TODO: We might need to handle the click behavior that updates dashboard filters? I can't figure out how get
;; that to actually attach to a filter to check what it looks like.
nil))) | |
Given the :visualization_settings (possibly nil) for an entity, return any embedded serdes-deps as a set. Always returns an empty set even if the input is nil. | (defn visualization-settings-deps
[viz]
(let [column-settings-keys-deps (some->> viz
:column_settings
keys
(map (comp mbql-deps json/parse-string name)))
column-settings-vals-deps (some->> viz
:column_settings
vals
(map viz-click-behavior-deps))
link-card-deps (viz-link-card-deps viz)
click-behavior-deps (viz-click-behavior-deps viz)]
(->> (concat column-settings-keys-deps
column-settings-vals-deps
[(mbql-deps viz) link-card-deps click-behavior-deps])
(filter some?)
(reduce set/union #{})))) |
(defn- viz-click-behavior-descendants [{:keys [click_behavior]}]
(when-let [{:keys [linkType targetId type]} click_behavior]
(case type
"link" (when-let [model (link-card-model->toucan-model linkType)]
#{[(name model) targetId]})
;; TODO: We might need to handle the click behavior that updates dashboard filters? I can't figure out how get
;; that to actually attach to a filter to check what it looks like.
nil))) | |
(defn- viz-column-settings-descendants [{:keys [column_settings]}]
(when column_settings
(->> (vals column_settings)
(mapcat viz-click-behavior-descendants)
set))) | |
Given the :visualization_settings (possibly nil) for an entity, return anything that should be considered a descendant. Always returns an empty set even if the input is nil. | (defn visualization-settings-descendants
[viz]
(set/union (viz-click-behavior-descendants viz)
(viz-column-settings-descendants viz))) |
Memoizing appdb lookups | |
Runs body with all functions marked with ::cache re-bound to memoized versions for performance. | (defmacro with-cache
[& body]
(let [ns* 'metabase.models.serialization]
`(binding ~(reduce into []
(for [[var-sym var] (ns-interns ns*)
:when (::cache (meta var))
:let [fq-sym (symbol (name ns*) (name var-sym))]]
[fq-sym `(memoize ~fq-sym)]))
~@body))) |
(ns metabase.models.session (:require [buddy.core.codecs :as codecs] [buddy.core.nonce :as nonce] [metabase.server.middleware.misc :as mw.misc] [metabase.server.request.util :as request.u] [methodical.core :as methodical] [schema.core :as s] [toucan2.core :as t2])) | |
(s/defn ^:private random-anti-csrf-token :- #"^[0-9a-f]{32}$"
[]
(codecs/bytes->hex (nonce/random-bytes 16))) | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase. | (def Session :model/Session) |
(methodical/defmethod t2/table-name :model/Session [_model] :core_session) | |
(doto :model/Session (derive :metabase/model) (derive :hook/created-at-timestamped?)) | |
(t2/define-before-update :model/Session [_] (throw (RuntimeException. "You cannot update a Session."))) | |
(t2/define-before-insert :model/Session
[session]
(cond-> session
(some-> mw.misc/*request* request.u/embedded?) (assoc :anti_csrf_token (random-anti-csrf-token)))) | |
(t2/define-after-insert :model/Session
[{anti-csrf-token :anti_csrf_token, :as session}]
(let [session-type (if anti-csrf-token :full-app-embed :normal)]
(assoc session :type session-type))) | |
Settings are a fast and simple way to create a setting that can be set from the admin page. They are saved to the application Database, but intelligently cached internally for super-fast lookups. Define a new Setting with [[defsetting]] (optionally supplying things like default value, type, or custom getters & setters): (defsetting mandrill-api-key "API key for Mandrill") The newly-defined Setting will automatically be made available to the frontend client depending on its [[Visibility]]. You can also set the value via the corresponding env var, which looks like The var created with [[defsetting]] can be used as a getter/setter, or you can use [[get]] and [[set!]]: (require '[metabase.models.setting :as setting]) (setting/get :mandrill-api-key) ; only returns values set explicitly from the Admin Panel (mandrill-api-key) ; returns value set in the Admin Panel, OR value of corresponding env var, ; OR the default value, if any (in that order) (setting/set! :mandrill-api-key "NEW_KEY") (mandrill-api-key! "NEW_KEY") (setting/set! :mandrill-api-key nil) (mandrill-api-key! nil) You can define additional Settings types adding implementations of [[default-tag-for-type]], [[get-value-of-type]], and [[set-value-of-type!]]. [[writable-settings]] and [[user-readable-values-map]] can be used to fetch all Admin-writable and User-readable Settings, respectively. See their docstrings for more information. User-local and Database-local SettingsStarting in 0.42.0, some Settings are allowed to have Database-specific values that override the normal site-wide value. Similarly, starting in 0.43.0, some Settings are allowed to have User-specific values. These are similar in concept to buffer-local variables in Emacs Lisp. When a Setting is allowed to be User or Database local, any values in [[user-local-values]] or
[[database-local-values]] for that Setting will be returned preferentially to site-wide values of that Setting.
[[user-local-values]] comes from the Whether or not a Setting can be User- or Database-local is controlled by the
If a User-local setting is written in the context of an API request (i.e., when [[metabase.api.common/current-user]] is bound), the value will be local to the current user. If it is written outside of an API request, a site-wide value will be written. (At the time of this writing, there is not yet a FE-client-friendly way to set Database-local values. Just set them manually in the application DB until we figure that out.) Custom setter functions do not affect User- or Database-local values; they always set the site-wide value. See #14055 and #19399 for more information about and motivation behind User- and Database-local Settings. | (ns metabase.models.setting
(:refer-clojure :exclude [get])
(:require
[cheshire.core :as json]
[clojure.core :as core]
[clojure.data :as data]
[clojure.data.csv :as csv]
[clojure.string :as str]
[environ.core :as env]
[medley.core :as m]
[metabase.api.common :as api]
[metabase.config :as config]
[metabase.events :as events]
[metabase.models.interface :as mi]
[metabase.models.serialization :as serdes]
[metabase.models.setting.cache :as setting.cache]
[metabase.plugins.classloader :as classloader]
[metabase.server.middleware.json]
[metabase.util :as u]
[metabase.util.date-2 :as u.date]
[metabase.util.i18n :refer [deferred-trs deferred-tru trs tru]]
[metabase.util.log :as log]
[methodical.core :as methodical]
[schema.core :as s]
[toucan2.core :as t2])
(:import
(clojure.lang Keyword Symbol)
(com.fasterxml.jackson.core JsonParseException)
(com.fasterxml.jackson.core.io JsonEOFException)
(java.io StringWriter)
(java.time.temporal Temporal)
(java.util.concurrent TimeUnit)
(java.util.concurrent.locks ReentrantLock))) |
this namespace is required for side effects since it has the JSON encoder definitions for | (comment metabase.server.middleware.json/keep-me) |
Database-local Settings values (as a map of Setting name -> already-deserialized value). This comes from the value of
This is normally bound automatically in Query Processor context by [[metabase.query-processor.middleware.resolve-database-and-driver]]. You may need to manually bind it in other places where you want to use Database-local values. TODO -- we should probably also bind this in sync contexts e.g. functions in [[metabase.sync]]. TODO -- a way to SET Database-local values. | (def ^:dynamic *database-local-values* nil) |
User-local Settings values (as a map of Setting name -> already-deserialized value). This comes from the value of
This is a delay so that the settings for a user are loaded only if and when they are actually needed during a given API request. This is normally bound automatically by session middleware, in [[metabase.server.middleware.session/do-with-current-user]]. | (def ^:dynamic *user-local-values* (delay (atom nil))) |
A set of setting names which existed in previous versions of Metabase, but are no longer used. New settings may not use these names to avoid unintended side-effects if an application database still stores values for these settings. | (def ^:private retired-setting-names
#{"-site-url"
"enable-advanced-humanization"
"metabot-enabled"
"ldap-sync-admin-group"
"user-recent-views"
"most-recently-viewed-dashboard"}) |
A dynamic val that controls whether it's allowed to use retired settings. Primarily used in test to disable retired setting check. | (def ^:dynamic *allow-retired-setting-names* false) |
(declare admin-writable-site-wide-settings get-value-of-type set-value-of-type!) | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase. | (def Setting :model/Setting) |
(methodical/defmethod t2/table-name :model/Setting [_model] :setting) | |
(doto :model/Setting (derive :metabase/model)) | |
(methodical/defmethod t2/primary-keys :model/Setting [_model] [:key]) | |
(t2/deftransforms :model/Setting
{:value mi/transform-encrypted-text}) | |
(defmethod serdes/hash-fields :model/Setting [_setting] [:key]) | |
(declare export?) | |
(defmethod serdes/extract-all "Setting" [_model _opts]
(for [{:keys [key value]} (admin-writable-site-wide-settings
:getter (partial get-value-of-type :string))
:when (export? key)]
{:serdes/meta [{:model "Setting" :id (name key)}]
:key key
:value value})) | |
(defmethod serdes/load-find-local "Setting" [[{:keys [id]}]]
(get-value-of-type :string (keyword id))) | |
(defmethod serdes/load-one! "Setting" [{:keys [key value]} _]
(set-value-of-type! :string key value)) | |
(def ^:private Type
(s/pred (fn [a-type]
(contains? (set (keys (methods get-value-of-type))) a-type))
"Valid Setting :type")) | |
(def ^:private Visibility (s/enum :public :authenticated :settings-manager :admin :internal)) | |
Type tag that will be included in the Setting's metadata, so that the getter function will not cause reflection warnings. | (defmulti default-tag-for-type
{:arglists '([setting-type])}
keyword) |
(defmethod default-tag-for-type :default [_] `Object) (defmethod default-tag-for-type :string [_] `String) (defmethod default-tag-for-type :boolean [_] `Boolean) (defmethod default-tag-for-type :integer [_] `Long) (defmethod default-tag-for-type :double [_] `Double) (defmethod default-tag-for-type :timestamp [_] `Temporal) (defmethod default-tag-for-type :keyword [_] `Keyword) | |
Check whether the | (defn- validate-default-value-for-type
[{:keys [tag default] :as _setting-definition}]
;; the errors below don't need to be i18n'ed since they're definition-time errors rather than user-facing
(when (some? tag)
(assert ((some-fn symbol? string?) tag) (format "Setting :tag should be a symbol or string, got: ^%s %s"
(.getCanonicalName (class tag))
(pr-str tag))))
(when (and (some? default)
(some? tag))
(let [klass (if (string? tag)
(try
(Class/forName tag)
(catch Throwable e
e))
(resolve tag))]
(when-not (class? klass)
(throw (ex-info (format "Cannot resolve :tag %s to a class. Is it fully qualified?" (pr-str tag))
{:tag klass}
(when (instance? Throwable klass) klass))))
(when-not (instance? klass default)
(throw (ex-info (format "Wrong :default type: got ^%s %s, but expected a %s"
(.getCanonicalName (class default))
(pr-str default)
(.getCanonicalName ^Class klass))
{:tag klass})))))) |
Schema for valid values of This is called | (def ^:private LocalOption (s/enum :only :allowed :never)) |
(def ^:private SettingDefinition
{:name s/Keyword
:munged-name s/Str
:namespace s/Symbol
:description s/Any ; description is validated via the macro, not schema
;; Use `:doc` to include a map with additional documentation, for use when generating the environment variable docs
;; from source. To exclude a setting from documenation, set to `false`. See metabase.cmd.env-var-dox.
:doc s/Any
:default s/Any
:type Type ; all values are stored in DB as Strings,
:getter clojure.lang.IFn ; different getters/setters take care of parsing/unparsing
:setter clojure.lang.IFn
:init (s/maybe clojure.lang.IFn) ; an init function can be used to seed initial values
:tag (s/maybe Symbol) ; type annotation, e.g. ^String, to be applied. Defaults to tag based on :type
:sensitive? s/Bool ; is this sensitive (never show in plaintext), like a password? (default: false)
:visibility Visibility ; where this setting should be visible (default: :admin)
:export? s/Bool ; should this setting be serialized?
:cache? s/Bool ; should the getter always fetch this value "fresh" from the DB? (default: false)
:deprecated (s/maybe s/Str) ; if non-nil, contains the Metabase version in which this setting was deprecated
;; whether this Setting can be Database-local or User-local. See [[metabase.models.setting]] docstring for more info.
:database-local LocalOption
:user-local LocalOption
;; called whenever setting value changes, whether from update-setting! or a cache refresh. used to handle cases
;; where a change to the cache necessitates a change to some value outside the cache, like when a change the
;; `:site-locale` setting requires a call to `java.util.Locale/setDefault`
:on-change (s/maybe clojure.lang.IFn)
;; If non-nil, determines the Enterprise feature flag required to use this setting. If the feature is not enabled,
;; the setting will behave the same as if `enabled?` returns `false` (see below).
:feature (s/maybe s/Keyword)
;; Function which returns true if the setting should be enabled. If it returns false, the setting will throw an
;; exception when it is attempted to be set, and will return its default value when read. Defaults to always enabled.
:enabled? (s/maybe clojure.lang.IFn)
;; Keyword that determines what kind of audit log entry should be created when this setting is written. Options are
;; `:never`, `:no-value`, `:raw-value`, and `:getter`. User- and database-local settings are never audited. `:getter`
;; should be used for most non-sensitive settings, and will log the value returned by its getter, which may be a
;; the default getter or a custom one.
;; (default: `:no-value`)
:audit (s/maybe (s/enum :never :no-value :raw-value :getter))}) | |
Map of loaded defsettings | (defonce
registered-settings
(atom {})) |
(defprotocol ^:private Resolvable
(resolve-setting [setting-definition-or-name]
"Resolve the definition map for a Setting. `setting-definition-or-name` map be a map, keyword, or string.")) | |
(extend-protocol Resolvable
clojure.lang.IPersistentMap
(resolve-setting [this] this)
String
(resolve-setting [s]
(resolve-setting (keyword s)))
clojure.lang.Keyword
(resolve-setting [k]
(or (@registered-settings k)
(throw (ex-info (tru "Unknown setting: {0}" k)
{:registered-settings
(sort (keys @registered-settings))}))))) | |
The actual watch that triggers this happens in [[metabase.models.setting.cache/cache*]] because the cache might be swapped out depending on which app DB we have in play this isn't really something that needs to be a multimethod, but I'm using it because the logic can't really live in [[metabase.models.setting.cache]] but the cache has to live here; this is a good enough way to prevent circular references for now | (defmethod setting.cache/call-on-change :default
[old new]
(let [rs @registered-settings
[d1 d2] (data/diff old new)]
(doseq [changed-setting (into (set (keys d1))
(set (keys d2)))]
(when-let [on-change (get-in rs [(keyword changed-setting) :on-change])]
(on-change (core/get old changed-setting) (core/get new changed-setting)))))) |
+----------------------------------------------------------------------------------------------------------------+ | get | +----------------------------------------------------------------------------------------------------------------+ | |
(defprotocol ^:private SettingName
(setting-name ^String [setting-definition-or-name]
"String name of a Setting, e.g. `\"site-url\"`. Works with strings, keywords, or Setting definition maps.")) | |
(extend-protocol SettingName
clojure.lang.IPersistentMap
(setting-name [this]
(name (:name this)))
String
(setting-name [this]
this)
clojure.lang.Keyword
(setting-name [this]
(name this))) | |
(defn- database-local-only? [setting] (= (:database-local (resolve-setting setting)) :only)) | |
(defn- user-local-only? [setting] (= (:user-local (resolve-setting setting)) :only)) | |
(defn- allows-database-local-values? [setting]
(#{:only :allowed} (:database-local (resolve-setting setting)))) | |
(defn- database-local-value [setting-definition-or-name]
(let [{setting-name :name, :as setting} (resolve-setting setting-definition-or-name)]
(when (allows-database-local-values? setting)
(core/get *database-local-values* setting-name)))) | |
(defn- allows-user-local-values? [setting]
(#{:only :allowed} (:user-local (resolve-setting setting)))) | |
(defn- allows-site-wide-values? [setting] (and (not (database-local-only? setting)) (not (user-local-only? setting)))) | |
(defn- site-wide-only? [setting] (and (not (allows-database-local-values? setting)) (not (allows-user-local-values? setting)))) | |
(defn- user-local-value [setting-definition-or-name]
(let [{setting-name :name, :as setting} (resolve-setting setting-definition-or-name)]
(when (allows-user-local-values? setting)
(core/get @@*user-local-values* setting-name)))) | |
(defn- should-set-user-local-value? [setting-definition-or-name]
(let [setting (resolve-setting setting-definition-or-name)]
(and (allows-user-local-values? setting)
@@*user-local-values*))) | |
(defn- set-user-local-value! [setting-definition-or-name value]
(let [{setting-name :name} (resolve-setting setting-definition-or-name)]
;; Update the atom in *user-local-values* with the new value before writing to the DB. This ensures that
;; subsequent setting updates within the same API request will not overwrite this value.
(swap! @*user-local-values* u/assoc-dissoc setting-name value)
(t2/update! 'User api/*current-user-id* {:settings (json/generate-string @@*user-local-values*)}))) | |
A dynamic var that controls whether we should enforce checks on setting access. Defaults to false; should be set to true when settings are being written directly via /api/setting endpoints. | (def ^:dynamic *enforce-setting-access-checks* false) |
(defn- has-feature?
[feature]
(u/ignore-exceptions
(classloader/require 'metabase.public-settings.premium-features))
(let [has-feature?' (resolve 'metabase.public-settings.premium-features/has-feature?)]
(has-feature?' feature))) | |
If | (defn has-advanced-setting-access?
[]
(or api/*is-superuser?*
(do
(when config/ee-available?
(classloader/require 'metabase-enterprise.advanced-permissions.common
'metabase.public-settings.premium-features))
(if-let [current-user-has-application-permissions?
(and (has-feature? :advanced-permissions)
(resolve 'metabase-enterprise.advanced-permissions.common/current-user-has-application-permissions?))]
(current-user-has-application-permissions? :setting)
false)))) |
This checks whether the current user should have the ability to read or write the provided setting. By default this function always returns | (defn- current-user-can-access-setting?
[setting]
(or (not *enforce-setting-access-checks*)
(nil? api/*current-user-id*)
api/*is-superuser?*
(and
;; Non-admin setting managers can only access settings that are not marked as admin-only
(not api/*is-superuser?*)
(has-advanced-setting-access?)
(not= (:visibility setting) :admin))
(and
;; Non-admins can only access user-local settings not marked as admin-only
(allows-user-local-values? setting)
(not= (:visibility setting) :admin)))) |
Munge names so that they are legal for bash. Only allows for alphanumeric characters, underscores, and hyphens. | (defn- munge-setting-name [setting-nm] (str/replace (name setting-nm) #"[^a-zA-Z0-9_-]*" "")) |
Get the env var corresponding to | (defn- env-var-name
^String [setting-definition-or-name]
(str "MB_" (-> (setting-name setting-definition-or-name)
munge-setting-name
(str/replace "-" "_")
u/upper-case-en))) |
Correctly translate a setting to the keyword it will be found at in [[env/env]]. | (defn setting-env-map-name [setting-definition-or-name] (keyword (str "mb-" (munge-setting-name (setting-name setting-definition-or-name))))) |
Get the value of | (defn env-var-value
^String [setting-definition-or-name]
(let [setting (resolve-setting setting-definition-or-name)]
(when (allows-site-wide-values? setting)
(let [v (env/env (setting-env-map-name setting))]
(when (seq v)
v))))) |
(def ^:private ^:dynamic *disable-cache* false) | |
(def ^:private ^:dynamic *disable-init* false) | |
(declare get) (declare set!) | |
Fetch the value of Note: This will bypass initialization, i.e. it could return nil for a nonce | (defn read-setting
[setting-definition-or-name]
(binding [*disable-init* true]
(get setting-definition-or-name))) |
(defn- db-value [setting-definition-or-name] (t2/select-one-fn :value Setting :key (setting-name setting-definition-or-name))) | |
(defn- db-is-set-up? []
;; this should never be hit. it is just overly cautious against a NPE here. But no way this cannot resolve
(let [f (requiring-resolve 'metabase.db/db-is-set-up?)]
(if f (f) false))) | |
Get the value, if any, of | (defn- db-or-cache-value
^String [setting-definition-or-name]
(let [setting (resolve-setting setting-definition-or-name)]
;; cannot use db (and cache populated from db) if db is not set up
(when (and (db-is-set-up?) (allows-site-wide-values? setting))
(not-empty
(if *disable-cache*
(db-value setting)
(do
;; gotcha - returns immediately if another process is restoring it, i.e. before it's been populated
(setting.cache/restore-cache-if-needed!)
(let [cache (setting.cache/cache)]
(if (nil? cache)
;; nil if we returned early above, and the cache is still being restored - in that case hit the db
(db-value setting)
(core/get cache (setting-name setting-definition-or-name)))))))))) |
(defonce ^:private ^ReentrantLock init-lock (ReentrantLock.)) | |
(defn- init! [setting-definition-or-name]
(let [{:keys [init] :as setting} (resolve-setting setting-definition-or-name)]
(when init
(when (not (db-is-set-up?))
(throw (ex-info "Cannot initialize setting before the db is set up" {:setting setting})))
;; We do not need to interact with the restore-cache-lock as it is OK to race with it.
(if-not (.tryLock init-lock 30 TimeUnit/SECONDS)
(throw (ex-info "Unable to get initialization lock" {:setting setting-definition-or-name}))
(try
(u/or-with some?
;; perhaps another process initialized this setting while we were waiting for the lock
(read-setting setting)
(when init
(when-let [init-value (init)]
(metabase.models.setting/set! setting init-value :bypass-read-only? true))))
(finally
(.unlock init-lock))))))) | |
Parsing a setting may result in a lazy value. Use this to ensure we finish parsing. | (defn- realize
[value]
(when (coll? value)
(dorun (map realize value)))
value) |
Get the | (defn default-value
[setting-definition-or-name]
(let [{:keys [default]} (resolve-setting setting-definition-or-name)]
default)) |
Get the raw value of a Setting from wherever it may be specified. Value is fetched by trying the following sources in order:
!!!!!!!!!! The value returned MAY OR MAY NOT be a String depending on the source !!!!!!!!!! This is the underlying function powering all the other getters such as methods of [[get-value-of-type]]. These getter functions must be coded to handle either String or non-String values. You can use the three-arity version of this function to do that. Three-arity version can be used to specify how to parse non-empty String values ( | (defn get-raw-value
([setting-definition-or-name]
(let [setting (resolve-setting setting-definition-or-name)
source-fns [user-local-value
database-local-value
env-var-value
db-or-cache-value
(cond
(:default setting) default-value
(:init setting) (when-not *disable-init*
init!))]]
(loop [[f & more] source-fns]
(let [v (when f (f setting))]
(cond
(some? v) v
(seq more) (recur more))))))
([setting-definition-or-name pred parse-fn]
(let [parse (fn [v]
(try
(realize (parse-fn v))
(catch Throwable e
(let [{setting-name :name} (resolve-setting setting-definition-or-name)]
(throw (ex-info (tru "Error parsing Setting {0}: {1}" setting-name (ex-message e))
{:setting setting-name}
e))))))
raw-value (get-raw-value setting-definition-or-name)
v (cond-> raw-value
(string? raw-value) parse)]
(when (pred v)
v)))) |
Get the value of Impls should call [[get-raw-value]] to get the underlying possibly-serialized value and parse it appropriately if it
comes back as a String; impls should only return values that are of the correct type (e.g. the | (defmulti get-value-of-type
{:arglists '([setting-type setting-definition-or-name])}
(fn [setting-type _]
(keyword setting-type))) |
(defmethod get-value-of-type :string [_setting-type setting-definition-or-name] (get-raw-value setting-definition-or-name string? identity)) | |
(s/defn string->boolean :- (s/maybe s/Bool)
"Interpret a `string-value` of a Setting as a boolean."
[string-value :- (s/maybe s/Str)]
(when (seq string-value)
(case (u/lower-case-en string-value)
"true" true
"false" false
(throw (Exception.
(tru "Invalid value for string: must be either \"true\" or \"false\" (case-insensitive).")))))) | |
The string representation of a type 4 random uuid | (defn random-uuid-str [] (str (random-uuid))) |
Strings are parsed as follows:
| (defmethod get-value-of-type :boolean [_setting-type setting-definition-or-name] (get-raw-value setting-definition-or-name boolean? string->boolean)) |
(defmethod get-value-of-type :integer [_setting-type setting-definition-or-name] (get-raw-value setting-definition-or-name integer? #(Long/parseLong ^String %))) | |
(defmethod get-value-of-type :positive-integer [_setting-type setting-definition-or-name] (get-raw-value setting-definition-or-name pos-int? #(Long/parseLong ^String %))) | |
(defmethod get-value-of-type :double [_setting-type setting-definition-or-name] (get-raw-value setting-definition-or-name double? #(Double/parseDouble ^String %))) | |
(defmethod get-value-of-type :keyword [_setting-type setting-definition-or-name] (get-raw-value setting-definition-or-name keyword? keyword)) | |
(defmethod get-value-of-type :timestamp [_setting-type setting-definition-or-name] (get-raw-value setting-definition-or-name #(instance? Temporal %) u.date/parse)) | |
(defmethod get-value-of-type :json [_setting-type setting-definition-or-name] (get-raw-value setting-definition-or-name coll? #(json/parse-string-strict % true))) | |
(defmethod get-value-of-type :csv [_setting-type setting-definition-or-name] (get-raw-value setting-definition-or-name sequential? (comp first csv/read-csv))) | |
(defn- default-getter-for-type [setting-type] (partial get-value-of-type (keyword setting-type))) | |
Fetch the value of Note: If the setting has an initializer, and this is the first time accessing, a value will be generated and saved unless disable-init has been bound to a truthy value. | (defn get
[setting-definition-or-name]
(let [{:keys [cache? getter enabled? default feature]} (resolve-setting setting-definition-or-name)
disable-cache? (or *disable-cache* (not cache?))]
(if (or (and feature (not (has-feature? feature)))
(and enabled? (not (enabled?))))
default
(binding [*disable-cache* disable-cache?]
(getter))))) |
+----------------------------------------------------------------------------------------------------------------+ | set! | +----------------------------------------------------------------------------------------------------------------+ | |
Update an existing Setting. Used internally by [[set-value-of-type!]] for | (defn- update-setting!
[setting-name new-value]
(assert (not= setting-name setting.cache/settings-last-updated-key)
(tru "You cannot update `settings-last-updated` yourself! This is done automatically."))
;; Toucan 2 version of `update!` will do transforms and stuff like that
(t2/update! Setting :key setting-name {:value new-value})) |
Insert a new row for a Setting. Used internally by [[set-value-of-type!]] for | (defn- set-new-setting!
[setting-name new-value]
(try (first (t2/insert-returning-instances! Setting
:key setting-name
:value new-value))
;; if for some reason inserting the new value fails it almost certainly means the cache is out of date
;; and there's actually a row in the DB that's not in the cache for some reason. Go ahead and update the
;; existing value and log a warning
(catch Throwable e
(log/warn (deferred-tru "Error inserting a new Setting:") "\n"
(.getMessage e) "\n"
(deferred-tru "Assuming Setting already exists in DB and updating existing value."))
(update-setting! setting-name new-value)))) |
(defn- obfuscated-value? [v]
(when (seq v)
(boolean (re-matches #"^\*{10}.{2}$" v)))) | |
Obfuscate the value of sensitive Setting. We'll still show the last 2 characters so admins can still check that the value is what's expected (e.g. the correct password). (obfuscate-value "sensitivePASSWORD123") ;; -> "**23" | (defn obfuscate-value [s] (str "**********" (str/join (take-last 2 (str s))))) |
Set the value of a Impls of this method should ultimately call the implementation for | (defmulti set-value-of-type!
{:arglists '([setting-type setting-definition-or-name new-value])}
(fn [setting-type _ _]
(keyword setting-type))) |
(s/defmethod set-value-of-type! :string
[_setting-type setting-definition-or-name new-value :- (s/maybe s/Str)]
(let [new-value (when (seq new-value)
new-value)
{:keys [sensitive? deprecated]
:as setting} (resolve-setting setting-definition-or-name)
obfuscated? (and sensitive? (obfuscated-value? new-value))
setting-name (setting-name setting)]
;; if someone attempts to set a sensitive setting to an obfuscated value (probably via a misuse of the `set-many!` function, setting values that have not changed), ignore the change. Log a message that we are ignoring it.
(if obfuscated?
(log/info (trs "Attempted to set Setting {0} to obfuscated value. Ignoring change." setting-name))
(do
(when (and deprecated (not (nil? new-value)))
(log/warn (trs "Setting {0} is deprecated as of Metabase {1} and may be removed in a future version."
setting-name
deprecated)))
(when (and
(= :only (:user-local setting))
(not (should-set-user-local-value? setting)))
(log/warn (trs "Setting {0} can only be set in a user-local way, but there are no *user-local-values*." setting-name)))
(if (should-set-user-local-value? setting)
;; If this is user-local and this is being set in the context of an API call, we don't want to update the
;; site-wide value or write or read from the cache
(set-user-local-value! setting-name new-value)
(do
;; make sure we're not trying to set the value of a Database-local-only Setting
(when-not (allows-site-wide-values? setting)
(throw (ex-info (tru "Site-wide values are not allowed for Setting {0}" (:name setting))
{:setting (:name setting)})))
;; always update the cache entirely when updating a Setting.
(setting.cache/restore-cache!)
;; write to DB
(cond
(nil? new-value)
(t2/delete! (t2/table-name Setting) :key setting-name)
;; if there's a value in the cache then the row already exists in the DB; update that
(contains? (setting.cache/cache) setting-name)
(update-setting! setting-name new-value)
;; if there's nothing in the cache then the row doesn't exist, insert a new one
:else
(set-new-setting! setting-name new-value))
;; update cached value
(setting.cache/update-cache! setting-name new-value)
;; Record the fact that a Setting has been updated so eventually other instances (if applicable) find out
;; about it (For Settings that don't use the Cache, don't update the `last-updated` value, because it will
;; cause other instances to do needless reloading of the cache from the DB)
(when-not *disable-cache*
(setting.cache/update-settings-last-updated!))))
;; Now return the `new-value`.
new-value)))) | |
(defmethod set-value-of-type! :keyword [_setting-type setting-definition-or-name new-value] (set-value-of-type! :string setting-definition-or-name (u/qualified-name new-value))) | |
(defmethod set-value-of-type! :boolean
[setting-type setting-definition-or-name new-value]
(if (string? new-value)
(set-value-of-type! setting-type setting-definition-or-name (string->boolean new-value))
(let [s (case new-value
true "true"
false "false"
nil nil)]
(set-value-of-type! :string setting-definition-or-name s)))) | |
(defmethod set-value-of-type! :integer
[_setting-type setting-definition-or-name new-value]
(set-value-of-type!
:string setting-definition-or-name
(when new-value
(assert (or (integer? new-value)
(and (string? new-value)
(re-matches #"^-?\d+$" new-value))))
(str new-value)))) | |
(defmethod set-value-of-type! :positive-integer
[_setting-type setting-definition-or-name new-value]
(set-value-of-type!
:string setting-definition-or-name
(when new-value
(assert (or (pos-int? new-value)
(and (string? new-value)
(re-matches #"^[1-9]\d*$" new-value))))
(str new-value)))) | |
(defmethod set-value-of-type! :double
[_setting-type setting-definition-or-name new-value]
(set-value-of-type!
:string setting-definition-or-name
(when new-value
(assert (or (number? new-value)
(and (string? new-value)
(re-matches #"[+-]?([0-9]*[.])?[0-9]+" new-value))))
(str new-value)))) | |
(defmethod set-value-of-type! :json [_setting-type setting-definition-or-name new-value] (set-value-of-type! :string setting-definition-or-name (some-> new-value json/generate-string))) | |
(defmethod set-value-of-type! :timestamp [_setting-type setting-definition-or-name new-value] (set-value-of-type! :string setting-definition-or-name (some-> new-value u.date/format))) | |
(defn- serialize-csv [value]
(cond
;; if we're passed as string, assume it's already CSV-encoded
(string? value)
value
(sequential? value)
(let [s (with-open [writer (StringWriter.)]
(csv/write-csv writer [value])
(str writer))]
(first (str/split-lines s)))
:else
value)) | |
(defmethod set-value-of-type! :csv [_setting-type setting-definition-or-name new-value] (set-value-of-type! :string setting-definition-or-name (serialize-csv new-value))) | |
(defn- default-setter-for-type [setting-type] (partial set-value-of-type! (keyword setting-type))) | |
(defn- audit-setting-change!
[{:keys [name audit sensitive?]} previous-value new-value]
(let [maybe-obfuscate #(cond-> % sensitive? obfuscate-value)]
(events/publish-event!
:event/setting-update
{:details (merge {:key name}
(when (not= audit :no-value)
{:previous-value (maybe-obfuscate previous-value)
:new-value (maybe-obfuscate new-value)}))
:user-id api/*current-user-id*
:model :model/Setting}))) | |
Returns true if the setting change should be written to the | (defn- should-audit? [setting] (not= (:audit setting) :never)) |
Calls the setting's setter with | (defn- set-with-audit-logging!
[{:keys [getter audit setter] setting-type :type :as setting} new-value bypass-read-only?]
(let [setter (if (and bypass-read-only? (= :none setter))
(partial set-value-of-type! setting-type setting)
setter)]
(if (should-audit? setting)
(let [audit-value-fn #(condp = audit
:no-value nil
:raw-value (get-raw-value setting)
:getter (getter))
previous-value (audit-value-fn)]
(u/prog1 (setter new-value)
(audit-setting-change! setting previous-value (audit-value-fn))))
(setter new-value)))) |
Set the value of (set :mandrill-api-key "xyz123") Style note: prefer using the setting directly instead: (mandrill-api-key "xyz123") | (defn set!
[setting-definition-or-name new-value & {:keys [bypass-read-only?]}]
(let [{:keys [setter cache? enabled? feature] :as setting} (resolve-setting setting-definition-or-name)
name (setting-name setting)]
(when (and feature (not (has-feature? feature)))
(throw (ex-info (tru "Setting {0} is not enabled because feature {1} is not available" name feature) setting)))
(when (and enabled? (not (enabled?)))
(throw (ex-info (tru "Setting {0} is not enabled" name) setting)))
(when-not (current-user-can-access-setting? setting)
(throw (ex-info (tru "You do not have access to the setting {0}" name) setting)))
(when-not bypass-read-only?
(when (= setter :none)
(throw (UnsupportedOperationException. (tru "You cannot set {0}; it is a read-only setting." name)))))
(binding [*disable-cache* (not cache?)]
(set-with-audit-logging! setting new-value bypass-read-only?)))) |
+----------------------------------------------------------------------------------------------------------------+ | register-setting! | +----------------------------------------------------------------------------------------------------------------+ | |
Register a new Setting with a map of [[SettingDefinition]] attributes. Returns the map it was passed. This is used internally by [[defsetting]]; you shouldn't need to use it yourself. | (defn register-setting!
[{setting-name :name, setting-ns :namespace, setting-type :type, default :default, :as setting}]
(let [munged-name (munge-setting-name (name setting-name))]
(u/prog1 (let [setting-type (s/validate Type (or setting-type :string))]
(merge
{:name setting-name
:munged-name munged-name
:namespace setting-ns
:description nil
:doc nil
:type setting-type
:default default
:on-change nil
:getter (partial (default-getter-for-type setting-type) setting-name)
:setter (partial (default-setter-for-type setting-type) setting-name)
:init nil
:tag (default-tag-for-type setting-type)
:visibility :admin
:export? false
:sensitive? false
:cache? true
:feature nil
:database-local :never
:user-local :never
:deprecated nil
:enabled? nil
;; Disable auditing by default for user- or database-local settings
:audit (if (site-wide-only? setting) :no-value :never)}
(dissoc setting :name :type :default)))
(s/validate SettingDefinition <>)
(validate-default-value-for-type <>)
;; eastwood complains about (setting-name @registered-settings) for shadowing the function `setting-name`
(when-let [registered-setting (core/get @registered-settings setting-name)]
(when (not= setting-ns (:namespace registered-setting))
(throw (ex-info (tru "Setting {0} already registered in {1}" setting-name (:namespace registered-setting))
{:existing-setting (dissoc registered-setting :on-change :getter :setter)}))))
(when-let [same-munge (first (filter (comp #{munged-name} :munged-name)
(vals @registered-settings)))]
(when (not= setting-name (:name same-munge)) ;; redefinitions are fine
(throw (ex-info (tru "Setting names in would collide: {0} and {1}"
setting-name (:name same-munge))
{:existing-setting (dissoc same-munge :on-change :getter :setter)
:new-setting (dissoc <> :on-change :getter :setter)}))))
(when (and (retired-setting-names (name setting-name)) (not *allow-retired-setting-names*))
(throw (ex-info (tru "Setting name ''{0}'' is retired; use a different name instead" (name setting-name))
{:retired-setting-name (name setting-name)
:new-setting (dissoc <> :on-change :getter :setter)})))
(when (and (allows-user-local-values? setting) (allows-database-local-values? setting))
(throw (ex-info (tru "Setting {0} allows both user-local and database-local values; this is not supported"
setting-name)
{:setting setting})))
(when (and (:enabled? setting) (:feature setting))
(throw (ex-info (tru "Setting {0} uses both :enabled? and :feature options, which are mutually exclusive"
setting-name)
{:setting setting})))
(swap! registered-settings assoc setting-name <>)))) |
+----------------------------------------------------------------------------------------------------------------+ | defsetting macro | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- setting-fn-docstring [{:keys [default description], setting-type :type, :as setting}]
;; indentation below is intentional to make it clearer what shape the generated documentation is going to take.
(str
(description) \newline
\newline
(format "`%s` is a `%s` Setting. You can get its value by calling:\n" (setting-name setting) setting-type)
\newline
(format " (%s)\n" (setting-name setting))
\newline
"and set its value by calling:\n"
\newline
(format " (%s! <new-value>)\n" (setting-name setting))
\newline
(format "You can also set its value with the env var `%s`.\n" (env-var-name setting))
\newline
"Clear its value by calling:\n"
\newline
(format " (%s! nil)\n" (setting-name setting))
\newline
(format "Its default value is `%s`." (pr-str default)))) | |
Impl for [[defsetting]]. Create metadata for [[setting-fn]]. | (defn setting-fn-metadata
[getter-or-setter {:keys [tag deprecated], :as setting}]
{:arglists (case getter-or-setter
:getter (list (with-meta [] {:tag tag}))
:setter (list (with-meta '[new-value] {:tag tag})))
:deprecated deprecated
:doc (setting-fn-docstring setting)}) |
Impl for [[defsetting]]. Create the automatically defined | (defn setting-fn
[getter-or-setter setting]
(case getter-or-setter
:getter (fn setting-getter* []
(get setting))
:setter (fn setting-setter* [new-value]
;; need to qualify this or otherwise the reader gets this confused with the set! used for things like
;; (set! *warn-on-reflection* true)
;; :refer-clojure :exclude doesn't seem to work in this case
(metabase.models.setting/set! setting new-value)))) |
The next few functions are for validating the Setting description (i.e., docstring) at macroexpansion time. They check that the docstring is a valid deferred i18n form (e.g. [[metabase.util.i18n/deferred-tru]]) so the Setting description will be localized properly when it shows up in the FE admin interface. | |
(def ^:private allowed-deferred-i18n-forms
#{`deferred-trs `deferred-tru}) | |
Whether (is-form? #{ | (defn- is-form?
[symbols form]
(when (and (list? form)
(symbol? (first form)))
;; resolve the symbol to a var and convert back to a symbol so we can get the actual name rather than whatever
;; alias the current namespace happens to be using
(let [symb (symbol (resolve (first form)))]
((set symbols) symb)))) |
(defn- valid-trs-or-tru? [desc] (is-form? allowed-deferred-i18n-forms desc)) | |
Check that | (defn- validate-description-form
[description-form]
(when-not (valid-trs-or-tru? description-form)
;; this doesn't need to be i18n'ed because it's a compile-time error.
(throw (ex-info (str "defsetting docstrings must be a *deferred* i18n form unless the Setting has"
" `:visibilty` `:internal`, `:setter` `:none`, or is defined in a test namespace."
(format " Got: ^%s %s"
(some-> description-form class (.getCanonicalName))
(pr-str description-form)))
{:description-form description-form})))
description-form) |
Is | (defn- in-test? [] (str/ends-with? (ns-name *ns*) "-test")) |
Defines a new Setting that will be added to the DB at some point in the future. Conveniently can be used as a getter/setter as well (defsetting mandrill-api-key (trs "API key for Mandrill.")) (mandrill-api-key) ; get the value (mandrill-api-key! new-value) ; update the value (mandrill-api-key! nil) ; delete the value A setting can be set from the Admin Panel or via the corresponding env var, eg. You may optionally pass any of the `:default`The default value of the setting. This must be of the same type as the Setting type, e.g. the default for an
`:type`
`:visibility`Controls where this setting is visibile, and who can update it. Possible values are: Visibility | Who Can See It? | Who Can Update It? ---------------- | ---------------------------- | -------------------- :public | The entire world | Admins and Settings Managers :authenticated | Logged-in Users | Admins and Settings Managers :settings-manager| Admins and Settings Managers | Admins and Settings Managers :admin | Admins | Admins :internal | Nobody | No one (usually for env-var-only settings) 'Settings Managers' are non-admin users with the 'settings' permission, which gives them access to the Settings page in the Admin Panel. `:export?`Whether this Setting is included when producing a serializing settings export. `:getter`A custom getter fn, which takes no arguments. Overrides the default implementation. (This can in turn call functions in this namespace like methods of [[get-value-of-type]] to invoke the 'parent' getter behavior.) `:setter`A custom setter fn, which takes a single argument, or `:cache?`Should this Setting be cached? (default `:sensitive?`Is this a sensitive setting, such as a password, that we should never return in plaintext? (Default: `:database-local`The ability of this Setting to be /Database-local/. Valid values are `:user-local`Whether this Setting is /User-local/. Valid values are `:deprecated`If this setting is deprecated, this should contain a string of the Metabase version in which the setting was
deprecated. A deprecation notice will be logged whenever the setting is written. (Default: `:on-change`Do you want to update something else when this setting changes? Takes a function which takes 2 arguments, `:feature`If non-nil, determines the Enterprise feature flag required to use this setting. If the feature is not enabled,
the setting will behave the same as if `enabled?`Function which returns true if the setting should be enabled. If it returns false, the setting will throw an exception when it is attempted to be set, and will return its default value when read. Defaults to always enabled. `audit`Keyword that determines what kind of audit log entry should be created when this setting is written. Options are
| (defmacro defsetting
{:style/indent 1}
[setting-symbol description & {:as options}]
{:pre [(symbol? setting-symbol)
(not (namespace setting-symbol))
;; don't put exclamation points in your Setting names. We don't want functions like `exciting!` for the getter
;; and `exciting!!` for the setter.
(not (str/includes? (name setting-symbol) "!"))]}
(let [description (if (or (= (:visibility options) :internal)
(= (:setter options) :none)
(in-test?))
description
(validate-description-form description))
;; wrap the description form in a thunk, so its result updates with its dependencies
description `(fn [] ~description)
definition-form (assoc options
:name (keyword setting-symbol)
:description description
:namespace (list 'quote (ns-name *ns*)))
;; create symbols for the getter and setter functions e.g. `my-setting` and `my-setting!` respectively.
;; preserve metadata from the `setting-symbol` passed to `defsetting`.
setting-getter-fn-symbol setting-symbol
setting-setter-fn-symbol (-> (symbol (str (name setting-symbol) \!))
(with-meta (meta setting-symbol)))
;; create a symbol for the Setting definition from [[register-setting!]]
setting-definition-symbol (gensym "setting-")]
`(let [~setting-definition-symbol (register-setting! ~definition-form)]
(-> (def ~setting-getter-fn-symbol (setting-fn :getter ~setting-definition-symbol))
(alter-meta! merge (setting-fn-metadata :getter ~setting-definition-symbol)))
~(when-not (= (:setter options) :none)
`(-> (def ~setting-setter-fn-symbol (setting-fn :setter ~setting-definition-symbol))
(alter-meta! merge (setting-fn-metadata :setter ~setting-definition-symbol))))))) |
+----------------------------------------------------------------------------------------------------------------+ | EXTRA UTIL FNS | +----------------------------------------------------------------------------------------------------------------+ | |
Set the value of several Settings at once. (set-many! {:mandrill-api-key "xyz123", :another-setting "ABC"}) | (defn set-many!
[settings]
;; if setting any of the settings fails, roll back the entire DB transaction and the restore the cache from the DB
;; to revert any changes in the cache
(try
(t2/with-transaction [_conn]
(doseq [[k v] settings]
(metabase.models.setting/set! k v)))
settings
(catch Throwable e
(setting.cache/restore-cache!)
(throw e)))) |
Get the value of a Setting that should be displayed to a User (i.e. via Accepts options:
| (defn user-facing-value
[setting-definition-or-name & {:keys [getter], :or {getter get}}]
(let [{:keys [sensitive? visibility default], k :name, :as setting} (resolve-setting setting-definition-or-name)
unparsed-value (get-value-of-type :string k)
parsed-value (getter k)
;; `default` and `env-var-value` are probably still in serialized form so compare
value-is-default? (= parsed-value default)
value-is-from-env-var? (some-> (env-var-value setting) (= unparsed-value))]
(cond
(not (current-user-can-access-setting? setting))
(throw (ex-info (tru "You do not have access to the setting {0}" k) setting))
;; TODO - Settings set via an env var aren't returned for security purposes. It is an open question whether we
;; should obfuscate them and still show the last two characters like we do for sensitive values that are set via
;; the UI.
(or value-is-default? value-is-from-env-var?)
nil
(= visibility :internal)
(throw (Exception. (tru "Setting {0} is internal" k)))
sensitive?
(obfuscate-value parsed-value)
:else
parsed-value))) |
(defn- set-via-env-var? [setting] (some? (env-var-value setting))) | |
(defn- export? [setting-name] (:export? (core/get @registered-settings (keyword setting-name)))) | |
(defn- user-facing-info
[{:keys [default description], k :name, :as setting} & {:as options}]
(let [from-env? (set-via-env-var? setting)]
{:key k
:value (try
(m/mapply user-facing-value setting options)
(catch Throwable e
(log/error e (trs "Error fetching value of Setting"))))
:is_env_setting from-env?
:env_name (env-var-name setting)
:description (str (description))
:default (if from-env?
(tru "Using value of env var {0}" (str \$ (env-var-name setting)))
default)})) | |
Returns a set of setting visibilities that the current user has read access to. | (defn current-user-readable-visibilities
[]
(set (concat [:public]
(when @api/*current-user*
[:authenticated])
(when (has-advanced-setting-access?)
[:settings-manager])
(when api/*is-superuser?*
[:admin])))) |
Returns a set of setting visibilities that the current user has write access to. | (defn current-user-writable-visibilities
[]
(set (concat []
(when (has-advanced-setting-access?)
[:settings-manager :authenticated :public])
(when api/*is-superuser?*
[:admin])))) |
Returns the user facing view of the registered settings satisfying the given predicate | (defn- user-facing-settings-matching
[pred options]
(into
[]
(comp (filter pred)
(map #(m/mapply user-facing-info % options)))
(sort-by :name (vals @registered-settings)))) |
Return a sequence of site-wide Settings maps in a format suitable for consumption by the frontend. (For security purposes, this doesn't return the value of a Setting if it was set via env var).
This is currently used by For settings managers who are not admins, only the subset of settings with the :settings-manager visibility level are returned. | (defn writable-settings
[& {:as options}]
;; ignore Database-local values, but not User-local values
(let [writable-visibilities (current-user-writable-visibilities)]
(binding [*database-local-values* nil]
(user-facing-settings-matching
(fn [setting]
(and (contains? writable-visibilities (:visibility setting))
(not= (:database-local setting) :only)))
options)))) |
Returns a sequence of site-wide Settings maps, similar to [[writable-settings]]. However, this function excludes User-local Settings in addition to Database-local Settings. Settings that are optionally user-local will be included with their site-wide value, if a site-wide value is set.
This is used in [[metabase-enterprise.serialization.dump/dump-settings]] to serialize site-wide Settings. | (defn admin-writable-site-wide-settings
[& {:as options}]
;; ignore User-local and Database-local values
(binding [*user-local-values* (delay (atom nil))
*database-local-values* nil]
(user-facing-settings-matching
(fn [setting]
(and (not= (:visibility setting) :internal)
(allows-site-wide-values? setting)))
options))) |
Returns true if a setting can be read according to the provided set of | (defn can-read-setting?
[setting allowed-visibilities]
(let [setting (resolve-setting setting)]
(boolean (and (not (:sensitive? setting))
(contains? allowed-visibilities (:visibility setting)))))) |
Returns Settings as a map of setting name -> site-wide value for a given set of [[Visibility]] keywords
e.g. Settings marked This is currently used by | (defn user-readable-values-map
[visibilities]
;; ignore Database-local values, but not User-local values
(binding [*database-local-values* nil]
(into
{}
(comp (filter (fn [[_setting-name setting]]
(and (not (database-local-only? setting))
(can-read-setting? setting visibilities))))
(map (fn [[setting-name]]
[setting-name (get setting-name)])))
@registered-settings))) |
Substitute an opaque exception to ensure no sensitive information in the raw value is exposed | (defn- redact-parse-ex
[ex]
(ex-info (trs "Error of type {0} thrown while parsing a setting" (type ex))
{:ex-type (type ex)})) |
(defn- may-contain-raw-token? [ex setting]
(case (:type setting)
:json
(cond
(instance? JsonEOFException ex) false
(instance? JsonParseException ex) true
:else (do (log/warn ex "Unexpected exception while parsing JSON")
;; err on the side of caution
true))
;; TODO: handle the remaining formats explicitly
true)) | |
(defn- redact-sensitive-tokens [ex raw-value]
(if (may-contain-raw-token? ex raw-value)
(redact-parse-ex ex)
ex)) | |
Test whether the value configured for a given setting can be parsed as the expected type. Returns an map containing the exception if an issue is encountered, or nil if the value passes validation. | (defn- validate-setting
[setting]
(when (= :json (:type setting))
(try
(binding [*disable-init* true]
(get-value-of-type (:type setting) setting))
nil
(catch clojure.lang.ExceptionInfo e
(let [parse-error (or (ex-cause e) e)
parse-error (redact-sensitive-tokens parse-error setting)
env-var? (set-via-env-var? setting)]
(assoc (select-keys setting [:name :type])
:parse-error parse-error
:env-var? env-var?)))))) |
Check whether there are any issues with the format of application settings, e.g. an invalid JSON string. Note that this will only check settings whose [[defsetting]] forms have already been evaluated. | (defn validate-settings-formatting!
[]
(doseq [invalid-setting (keep validate-setting (vals @registered-settings))]
(if (:env-var? invalid-setting)
(throw (ex-info (trs "Invalid {0} configuration for setting: {1}"
#_:clj-kondo/ignore (str/upper-case (name (:type invalid-setting)))
(name (:name invalid-setting)))
(dissoc invalid-setting :parse-error)
(:parse-error invalid-setting)))
(log/warn (:parse-error invalid-setting)
(format "Unable to parse setting %s" (:name invalid-setting)))))) |
Settings cache. Cache is a 1:1 mapping of what's in the DB. Cached lookup time is ~60µs, compared to ~1800µs for DB lookup. | (ns metabase.models.setting.cache (:require [clojure.core :as core] [clojure.java.jdbc :as jdbc] [metabase.db.connection :as mdb.connection] [metabase.util :as u] [metabase.util.honey-sql-2 :as h2x] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [toucan2.core :as t2]) (:import (java.util.concurrent.locks ReentrantLock))) |
(set! *warn-on-reflection* true) | |
Whenever something changes in the Settings cache it will invoke (call-on-change old-cache new-cache Actual implementation is provided in [[metabase.models.setting]] rather than here (to prevent circular references). | (defmulti call-on-change
{:arglists '([old new])}
(constantly :default)) |
Setting cache is unique to the application DB; if it's swapped out for tests or mocking or whatever then use a new cache. | (def ^:private ^{:arglists '([])} cache*
(mdb.connection/memoize-for-application-db
(fn []
(doto (atom nil)
(add-watch :call-on-change (fn [_key _ref old new]
(call-on-change old new))))))) |
Fetch the current contents of the Settings cache, a map of key (string) -> value (string). | (defn cache [] @(cache*)) |
Update the String value of a Setting in the Settings cache. | (defn update-cache!
[setting-name, ^String new-value]
(if (seq new-value)
(swap! (cache*) assoc setting-name new-value)
(swap! (cache*) dissoc setting-name))) |
CACHE SYNCHRONIZATION When running multiple Metabase instances (horizontal scaling), it is of course possible for one instance to update a Setting, and, since Settings are cached (to avoid tons of DB calls), for the other instances to then have an out-of-date cache. Thus we need a way for instances to know when their caches are out of date, so they can update them accordingly. Here is our solution: We will record the last time any Setting was updated in a special Setting called Since Because different machines can have out-of-sync clocks, we'll rely entirely on the application DB for caclulating
and comparing values of | |
Internal key used to store the last updated timestamp for Settings. | (def ^String settings-last-updated-key "settings-last-updated") |
Update the value of | (defn update-settings-last-updated!
[]
(log/debug (trs "Updating value of settings-last-updated in DB..."))
;; for MySQL, cast(current_timestamp AS char); for H2 & Postgres, cast(current_timestamp AS text)
(let [current-timestamp-as-string-honeysql (h2x/cast (if (= (mdb.connection/db-type) :mysql) :char :text)
[:raw "current_timestamp"])]
;; attempt to UPDATE the existing row. If no row exists, `t2/update!` will return 0...
(or (pos? (t2/update! :setting {:key settings-last-updated-key} {:value current-timestamp-as-string-honeysql}))
;; ...at which point we will try to INSERT a new row. Note that it is entirely possible two instances can both
;; try to INSERT it at the same time; one instance would fail because it would violate the PK constraint on
;; `key`, and throw a SQLException. As long as one instance updates the value, we are fine, so we can go ahead
;; and ignore that Exception if one is thrown.
(try
;; Use `simple-insert!` because we do *not* want to trigger pre-insert behavior, such as encrypting `:value`
(t2/insert! (t2/table-name (t2/resolve-model 'Setting)) :key settings-last-updated-key, :value current-timestamp-as-string-honeysql)
(catch java.sql.SQLException e
;; go ahead and log the Exception anyway on the off chance that it *wasn't* just a race condition issue
(log/error (trs "Error updating Settings last updated value: {0}"
(with-out-str (jdbc/print-sql-exception-chain e))))))))
;; Now that we updated the value in the DB, go ahead and update our cached value as well, because we know about the
;; changes
(swap! (cache*) assoc settings-last-updated-key (t2/select-one-fn :value 'Setting :key settings-last-updated-key))) |
Check whether our Settings cache is out of date. We know the cache is out of date if either of the following conditions is true:
| (defn- cache-out-of-date?
[]
(log/debug (trs "Checking whether settings cache is out of date (requires DB call)..."))
(let [current-cache (cache)]
(boolean
(or
;; is the cache empty?
(not current-cache)
;; if not, get the cached value of `settings-last-updated`, and if it exists...
(when-let [last-known-update (core/get current-cache settings-last-updated-key)]
;; compare it to the value in the DB. This is done be seeing whether a row exists
;; WHERE value > <local-value>
(u/prog1 (t2/select-one-fn :value 'Setting
{:where [:and
[:= :key settings-last-updated-key]
[:> :value last-known-update]]})
(log/trace "last known Settings update: " (pr-str last-known-update))
(log/trace "actual last Settings update:" (pr-str <>))
(when <>
(log/info (u/format-color 'red
(trs "Settings have been changed on another instance, and will be reloaded here.")))))))))) |
How often we should check whether the Settings cache is out of date (which requires a DB call)? | (def ^:private ^:const cache-update-check-interval-ms (u/minutes->ms 1)) |
(defonce ^:private last-update-check (atom 0)) | |
Has it has been more than a minute since the last time we checked for updates? | (defn- time-for-another-update-check?
[]
(> (- (System/currentTimeMillis) @last-update-check)
cache-update-check-interval-ms)) |
Populate cache with the latest hotness from the db | (defn restore-cache! [] (log/debug (trs "Refreshing Settings cache...")) (reset! (cache*) (t2/select-fn->fn :key :value 'Setting))) |
(defonce ^:private ^ReentrantLock restore-cache-lock (ReentrantLock.)) | |
Check whether we need to repopulate the cache with fresh values from the DB (because the cache is either empty or
known to be out-of-date), and do so if needed. This is intended to be called every time a Setting value is
retrieved, so it should be efficient; thus the calculation ( | (defn restore-cache-if-needed!
[]
;; There's a potential race condition here where two threads both call this at the exact same moment, and both get
;; `true` when they call `should-restore-cache`, and then both simultaneously try to update the cache (or, one
;; updates the cache, but the other calls `should-restore-cache?` and gets `true` before the other calls
;; `memo-swap!` (see below))
;;
;; This is not desirable, since either situation would result in duplicate work. Better to just add a quick lock
;; here so only one of them does it, since at any rate waiting for the other thread to finish the task in progress is
;; certainly quicker than starting the task ourselves from scratch
(when (time-for-another-update-check?)
;; if the lock is not already held by any thread, including this one...
(when-not (.isLocked restore-cache-lock)
;; attempt to acquire the lock. Returns immediately if lock is already held.
(when (.tryLock restore-cache-lock)
(try
(reset! last-update-check (System/currentTimeMillis))
(when (cache-out-of-date?)
(restore-cache!))
(finally
(.unlock restore-cache-lock))))))) |
Helper macros for defining Settings that can have multiple getter/setter implementations. The implementation that gets used is determined at runtime when the getter or setter is invoked by a dispatch function. This functionality was originally intended to facilitate separate EE and OSS versions of Settings, but rather than
restrict the impls to just See PR #16365 for more context. | (ns metabase.models.setting.multi-setting (:require [metabase.models.setting :as setting] [metabase.util.i18n :refer [tru]])) |
(set! *warn-on-reflection* true) | |
Determine the dispatch value for a multi-Setting defined by | (defmulti dispatch-multi-setting
{:arglists '([setting-key])}
keyword) |
Get the value of a multi-Setting defined by | (defmulti get-multi-setting
{:arglists '([setting-key impl])}
(fn [setting-key impl]
[(keyword setting-key) (keyword impl)])) |
Update the value of a multi-Setting defined by | (defmulti set-multi-setting
{:arglists '([setting-key impl new-value])}
(fn [setting-key impl _]
[(keyword setting-key) (keyword impl)])) |
Define a Setting that can have multiple getter/setter implementations. The implementation used is determined by
calling defsetting : define-multi-setting :: defn : defmulti | (defmacro define-multi-setting
{:style/indent :defn}
[setting-symbol doc dispatch-thunk & {:as options}]
(let [setting-key (keyword setting-symbol)
options (merge {:getter `(fn []
(get-multi-setting ~setting-key (dispatch-multi-setting ~setting-key)))
:setter `(fn [new-value#]
(set-multi-setting ~setting-key (dispatch-multi-setting ~setting-key) new-value#))}
options)]
`(do
(let [dispatch-thunk# ~dispatch-thunk]
(defmethod dispatch-multi-setting ~setting-key
[~'_]
(dispatch-thunk#)))
(setting/defsetting ~setting-symbol
~doc
~@(mapcat identity options))))) |
Define a implementation for a Setting defined by define-multi-setting : define-multi-setting-impl :: defmulti : defmethod See | (defmacro define-multi-setting-impl
[setting-symbol dispatch-value & {:keys [getter setter]}]
(let [setting-key (keyword (name setting-symbol))
dispatch-value (keyword dispatch-value)]
`(do
~(when getter
`(let [getter# ~getter]
(defmethod get-multi-setting [~setting-key ~dispatch-value]
[~'_ ~'_]
(getter#))))
~(when setter
(if (= setter :none)
`(defmethod set-multi-setting [~setting-key ~dispatch-value]
[~'_ ~'_ ~'_]
(throw (UnsupportedOperationException. (tru "You cannot set {0}; it is a read-only setting." ~setting-key))))
`(let [setter# ~setter]
(defmethod set-multi-setting [~setting-key ~dispatch-value]
[~'_ ~'_ new-value#]
(setter# new-value#)))))))) |
(ns metabase.models.table (:require [metabase.db.connection :as mdb.connection] [metabase.db.util :as mdb.u] [metabase.driver :as driver] [metabase.models.audit-log :as audit-log] [metabase.models.database :refer [Database]] [metabase.models.field :refer [Field]] [metabase.models.field-values :refer [FieldValues]] [metabase.models.humanization :as humanization] [metabase.models.interface :as mi] [metabase.models.permissions :as perms :refer [Permissions]] [metabase.models.serialization :as serdes] [metabase.util :as u] [methodical.core :as methodical] [toucan2.core :as t2])) | |
----------------------------------------------- Constants + Entity ----------------------------------------------- | |
Valid values for | (def visibility-types
#{:hidden :technical :cruft}) |
Valid values for | (def field-orderings
#{:database :alphabetical :custom :smart}) |
--------------------------------------------------- Lifecycle ---------------------------------------------------- | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all the Table symbol in our codebase. | (def Table :model/Table) |
(methodical/defmethod t2/table-name :model/Table [_model] :metabase_table) | |
(doto :model/Table (derive :metabase/model) (derive ::mi/read-policy.full-perms-for-perms-set) (derive ::mi/write-policy.full-perms-for-perms-set) (derive :hook/timestamped?)) | |
(t2/deftransforms :model/Table
{:entity_type mi/transform-keyword
:visibility_type mi/transform-keyword
:field_order mi/transform-keyword}) | |
(methodical/defmethod t2/model-for-automagic-hydration [:default :table] [_original-model _k] :model/Table) | |
(t2/define-before-insert :model/Table
[table]
(let [defaults {:display_name (humanization/name->human-readable-name (:name table))
:field_order (driver/default-field-order (t2/select-one-fn :engine Database :id (:db_id table)))}]
(merge defaults table))) | |
(t2/define-before-delete :model/Table
[{:keys [db_id schema id]}]
(t2/delete! Permissions :object [:like (str "%" (perms/data-perms-path db_id schema id) "%")])) | |
(defmethod mi/perms-objects-set :model/Table
[{db-id :db_id, schema :schema, table-id :id, :as table} read-or-write]
;; To read (e.g., fetch metadata) a Table you must have either self-service data permissions for the Table, or write
;; permissions for the Table (detailed below). `can-read?` checks the former, while `can-write?` checks the latter;
;; the permission-checking function to call when reading a Table depends on the context of the request. When reading
;; Tables to power the admin data model page; `can-write?` should be called; in other contexts, `can-read?` should
;; be called. (TODO: is there a way to clear up the semantics here?)
;;
;; To write a Table (e.g. update its metadata):
;; * If Enterprise Edition code is available and the :advanced-permissions feature is enabled, you must have
;; data-model permissions for othe table
;; * Else, you must be an admin
#{(case read-or-write
:read (perms/table-read-path table)
:write (perms/data-model-write-perms-path db-id schema table-id))}) | |
(defmethod serdes/hash-fields :model/Table [_table] [:schema :name (serdes/hydrated-hash :db)]) | |
------------------------------------------------ Field ordering ------------------------------------------------- | |
How should we order fields. | (def field-order-rule [[:position :asc] [:%lower.name :asc]]) |
Update | (defn update-field-positions!
[table]
(doall
(map-indexed (fn [new-position field]
(t2/update! Field (u/the-id field) {:position new-position}))
;; Can't use `select-field` as that returns a set while we need an ordered list
(t2/select [Field :id]
:table_id (u/the-id table)
{:order-by (case (:field_order table)
:custom [[:custom_position :asc]]
:smart [[[:case
(mdb.u/isa :semantic_type :type/PK) 0
(mdb.u/isa :semantic_type :type/Name) 1
(mdb.u/isa :semantic_type :type/Temporal) 2
:else 3]
:asc]
[:%lower.name :asc]]
:database [[:database_position :asc]]
:alphabetical [[:%lower.name :asc]])})))) |
Field ordering is valid if all the fields from a given table are present and only from that table. | (defn- valid-field-order?
[table field-ordering]
(= (t2/select-pks-set Field
:table_id (u/the-id table)
:active true)
(set field-ordering))) |
Set field order to | (defn custom-order-fields!
[table field-order]
{:pre [(valid-field-order? table field-order)]}
(t2/update! Table (u/the-id table) {:field_order :custom})
(doall
(map-indexed (fn [position field-id]
(t2/update! Field field-id {:position position
:custom_position position}))
field-order))) |
--------------------------------------------------- Hydration ---------------------------------------------------- | |
(mi/define-simple-hydration-method fields
:fields
"Return the Fields belonging to a single `table`."
[{:keys [id]}]
(t2/select Field
:table_id id
:active true
:visibility_type [:not= "retired"]
{:order-by field-order-rule})) | |
(mi/define-simple-hydration-method ^{:arglists '([table])} field-values
:field_values
"Return the FieldValues for all Fields belonging to a single `table`."
[{:keys [id]}]
(let [field-ids (t2/select-pks-set Field
:table_id id
:visibility_type "normal"
{:order-by field-order-rule})]
(when (seq field-ids)
(t2/select-fn->fn :field_id :values FieldValues, :field_id [:in field-ids])))) | |
(mi/define-simple-hydration-method ^{:arglists '([table])} pk-field-id
:pk_field
"Return the ID of the primary key `Field` for `table`."
[{:keys [id]}]
(t2/select-one-pk Field
:table_id id
:semantic_type (mdb.u/isa :type/PK)
:visibility_type [:not-in ["sensitive" "retired"]])) | |
(defn- with-objects [hydration-key fetch-objects-fn tables]
(let [table-ids (set (map :id tables))
table-id->objects (group-by :table_id (when (seq table-ids)
(fetch-objects-fn table-ids)))]
(for [table tables]
(assoc table hydration-key (get table-id->objects (:id table) []))))) | |
(mi/define-batched-hydration-method with-segments
:segments
"Efficiently hydrate the Segments for a collection of `tables`."
[tables]
(with-objects :segments
(fn [table-ids]
(t2/select :model/Segment :table_id [:in table-ids], :archived false, {:order-by [[:name :asc]]}))
tables)) | |
(mi/define-batched-hydration-method with-metrics
:metrics
"Efficiently hydrate the Metrics for a collection of `tables`."
[tables]
(with-objects :metrics
(fn [table-ids]
(t2/select :model/Metric :table_id [:in table-ids], :archived false, {:order-by [[:name :asc]]}))
tables)) | |
Efficiently hydrate the Fields for a collection of | (defn with-fields
[tables]
(with-objects :fields
(fn [table-ids]
(t2/select Field
:active true
:table_id [:in table-ids]
:visibility_type [:not= "retired"]
{:order-by field-order-rule}))
tables)) |
------------------------------------------------ Convenience Fns ------------------------------------------------- | |
Return the | (defn database [table] (t2/select-one Database :id (:db_id table))) |
Retrieve the | (def ^{:arglists '([table-id])} table-id->database-id
(mdb.connection/memoize-for-application-db
(fn [table-id]
{:pre [(integer? table-id)]}
(t2/select-one-fn :db_id Table, :id table-id)))) |
------------------------------------------------- Serialization ------------------------------------------------- | (defmethod serdes/dependencies "Table" [table]
[[{:model "Database" :id (:db_id table)}]]) |
(defmethod serdes/generate-path "Table" [_ table]
(let [db-name (t2/select-one-fn :name 'Database :id (:db_id table))]
(filterv some? [{:model "Database" :id db-name}
(when (:schema table)
{:model "Schema" :id (:schema table)})
{:model "Table" :id (:name table)}]))) | |
(defmethod serdes/entity-id "Table" [_ {:keys [name]}]
name) | |
(defmethod serdes/load-find-local "Table"
[path]
(let [db-name (-> path first :id)
schema-name (when (= 3 (count path))
(-> path second :id))
table-name (-> path last :id)
db-id (t2/select-one-pk Database :name db-name)]
(t2/select-one Table :name table-name :db_id db-id :schema schema-name))) | |
(defmethod serdes/extract-one "Table"
[_model-name _opts {:keys [db_id] :as table}]
(-> (serdes/extract-one-basics "Table" table)
(assoc :db_id (t2/select-one-fn :name 'Database :id db_id)))) | |
(defmethod serdes/load-xform "Table"
[{:keys [db_id] :as table}]
(-> (serdes/load-xform-basics table)
(assoc :db_id (t2/select-one-fn :id 'Database :name db_id)))) | |
(defmethod serdes/storage-path "Table" [table _ctx]
(concat (serdes/storage-table-path-prefix (serdes/path table))
[(:name table)])) | |
-------------------------------------------------- Audit Log Table ------------------------------------------------- | |
(defmethod audit-log/model-details Table [table _event-type] (select-keys table [:id :name :db_id])) | |
Each row in the The | (ns metabase.models.table-privileges (:require [methodical.core :as methodical] [toucan2.core :as t2])) |
(methodical/defmethod t2/table-name :model/TablePrivileges [_model] :table_privileges) | |
(derive :model/TablePrivileges :metabase/model) | |
(ns metabase.models.task-history (:require [cheshire.generate :refer [add-encoder encode-map]] [java-time.api :as t] [metabase.models.interface :as mi] [metabase.models.permissions :as perms] [metabase.public-settings.premium-features :as premium-features] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [methodical.core :as methodical] [toucan2.core :as t2])) | |
(set! *warn-on-reflection* true) | |
----------------------------------------------- Entity & Lifecycle ----------------------------------------------- | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase. | (def TaskHistory :model/TaskHistory) |
(methodical/defmethod t2/table-name :model/TaskHistory [_model] :task_history) | |
(doto :model/TaskHistory (derive :metabase/model) (derive ::mi/read-policy.full-perms-for-perms-set) (derive ::mi/write-policy.full-perms-for-perms-set)) | |
Permissions to read or write Task. If | (defmethod mi/perms-objects-set TaskHistory
[_task _read-or-write]
#{(if (premium-features/enable-advanced-permissions?)
(perms/application-perms-path :monitoring)
"/")}) |
Deletes older TaskHistory rows. Will order TaskHistory by | (defn cleanup-task-history!
[num-rows-to-keep]
;; Ideally this would be one query, but MySQL does not allow nested queries with a limit. The query below orders the
;; tasks by the time they finished, newest first. Then finds the first row after skipping `num-rows-to-keep`. Using
;; the date that task finished, it deletes everything after that. As we continue to add TaskHistory entries, this
;; ensures we'll have a good amount of history for debugging/troubleshooting, but not grow too large and fill the
;; disk.
(when-let [clean-before-date (t2/select-one-fn :ended_at TaskHistory {:limit 1
:offset num-rows-to-keep
:order-by [[:ended_at :desc]]})]
(t2/delete! (t2/table-name TaskHistory) :ended_at [:<= clean-before-date]))) |
(t2/deftransforms :model/TaskHistory
{:task_details mi/transform-json}) | |
Return all TaskHistory entries, applying | (mu/defn all
[limit :- [:maybe ms/PositiveInt]
offset :- [:maybe ms/IntGreaterThanOrEqualToZero]]
(t2/select TaskHistory (merge {:order-by [[:ended_at :desc]]}
(when limit
{:limit limit})
(when offset
{:offset offset})))) |
+----------------------------------------------------------------------------------------------------------------+ | with-task-history macro | +----------------------------------------------------------------------------------------------------------------+ | |
Schema for | (def ^:private TaskHistoryInfo
[:map {:closed true}
[:task ms/NonBlankString] ; task name, i.e. `send-pulses`. Conventionally lisp-cased
[:db_id {:optional true} [:maybe :int]] ; DB involved, for sync operations or other tasks where this is applicable.
[:task_details {:optional true} [:maybe :map]]]) ; additional map of details to include in the recorded row |
(defn- save-task-history! [start-time-ms info]
(let [end-time-ms (System/currentTimeMillis)
duration-ms (- end-time-ms start-time-ms)]
(try
(first (t2/insert-returning-instances! TaskHistory
(assoc info
:started_at (t/instant start-time-ms)
:ended_at (t/instant end-time-ms)
:duration duration-ms)))
(catch Throwable e
(log/warn e (trs "Error saving task history")))))) | |
Impl for | (mu/defn do-with-task-history
[info :- TaskHistoryInfo f]
(let [start-time-ms (System/currentTimeMillis)]
(try
(u/prog1 (f)
(save-task-history! start-time-ms info))
(catch Throwable e
(let [info (assoc info :task_details {:status :failed
:exception (class e)
:message (.getMessage e)
:stacktrace (u/filtered-stacktrace e)
:ex-data (ex-data e)
:original-info (:task_details info)})]
(save-task-history! start-time-ms info))
(throw e))))) |
Execute (with-task-history {:task "send-pulses"} ...) | (defmacro with-task-history
{:style/indent 1}
[info & body]
`(do-with-task-history ~info (fn [] ~@body))) |
TaskHistory can contain an exception for logging purposes, so use the built-in
serialization of a | (add-encoder Throwable (fn [throwable json-generator] (encode-map (Throwable->map throwable) json-generator))) |
(ns metabase.models.timeline (:require [java-time.api :as t] [metabase.models.collection.root :as collection.root] [metabase.models.permissions :as perms] [metabase.models.serialization :as serdes] [metabase.models.timeline-event :as timeline-event] [metabase.util.date-2 :as u.date] [methodical.core :as methodical] [toucan2.core :as t2])) | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase. | (def Timeline :model/Timeline) |
(methodical/defmethod t2/table-name :model/Timeline [_model] :timeline) | |
(doto :model/Timeline (derive :metabase/model) (derive ::perms/use-parent-collection-perms) (derive :hook/timestamped?) (derive :hook/entity-id)) | |
transforms | |
(t2/define-after-select :model/Timeline
[timeline]
;; We used to have a "balloons" icon but we removed it.
;; Use the default icon instead. (metabase#34586, metabase#35129)
(update timeline :icon (fn [icon]
(if (= icon "balloons") timeline-event/default-icon icon)))) | |
functions | |
Load timelines based on | (defn timelines-for-collection
[collection-id {:keys [:timeline/events? :timeline/archived?] :as options}]
(cond-> (t2/hydrate (t2/select Timeline
:collection_id collection-id
:archived (boolean archived?))
:creator
[:collection :can_write])
(nil? collection-id) (->> (map collection.root/hydrate-root-collection))
events? (timeline-event/include-events options))) |
(defmethod serdes/hash-fields :model/Timeline [_timeline] [:name (serdes/hydrated-hash :collection) :created_at]) | |
serialization | (defmethod serdes/extract-query "Timeline" [_model-name opts]
(eduction (map #(timeline-event/include-events-singular % {:all? true}))
(serdes/extract-query-collections Timeline opts))) |
(defn- extract-events [events]
(sort-by :timestamp
(for [event events]
(-> (into (sorted-map) event)
(dissoc :creator :id :timeline_id :updated_at)
(update :creator_id serdes/*export-user*)
(update :timestamp #(u.date/format (t/offset-date-time %))))))) | |
(defmethod serdes/extract-one "Timeline"
[_model-name _opts timeline]
(let [timeline (if (contains? timeline :events)
timeline
(timeline-event/include-events-singular timeline {:all? true}))]
(-> (serdes/extract-one-basics "Timeline" timeline)
(update :events extract-events)
(update :collection_id serdes/*export-fk* 'Collection)
(update :creator_id serdes/*export-user*)))) | |
(defmethod serdes/load-xform "Timeline" [timeline]
(-> timeline
serdes/load-xform-basics
(update :collection_id serdes/*import-fk* 'Collection)
(update :creator_id serdes/*import-user*))) | |
(defmethod serdes/load-one! "Timeline" [ingested maybe-local]
(let [timeline ((get-method serdes/load-one! :default) (dissoc ingested :events) maybe-local)]
(doseq [event (:events ingested)]
(let [local (t2/select-one 'TimelineEvent :timeline_id (:id timeline) :timestamp (u.date/parse (:timestamp event)))
event (assoc event
:timeline_id (:entity_id timeline)
:serdes/meta [{:model "Timeline" :id (:entity_id timeline)}
{:model "TimelineEvent" :id (u.date/format (t/offset-date-time (:timestamp event)))}])]
(serdes/load-one! event local))))) | |
(defmethod serdes/dependencies "Timeline" [{:keys [collection_id]}]
[[{:model "Collection" :id collection_id}]]) | |
(ns metabase.models.timeline-event (:require [metabase.models.interface :as mi] [metabase.models.serialization :as serdes] [metabase.util.date-2 :as u.date] [metabase.util.honey-sql-2 :as h2x] [methodical.core :as methodical] [toucan2.core :as t2])) | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase. | (def TimelineEvent :model/TimelineEvent) |
(methodical/defmethod t2/table-name :model/TimelineEvent [_model] :timeline_event) | |
(doto TimelineEvent (derive :metabase/model) (derive :hook/timestamped?) (derive ::mi/read-policy.full-perms-for-perms-set) (derive ::mi/write-policy.full-perms-for-perms-set)) | |
schemas | |
The default icon for Timeline and TimelineEvents. | (def default-icon "star") |
Schema for Timeline and TimelineEvents | (def Icon [:enum default-icon "cake" "mail" "warning" "bell" "cloud"]) |
Timeline Event Source Schema. For Snowplow Events, where the Event is created from is important.
Events are added from one of three sources: | (def Source [:enum "collections" "question"]) |
transforms | |
(t2/define-after-select :model/TimelineEvent
[timeline-event]
;; We used to have a "balloons" icon but we removed it.
;; Use the default icon instead. (metabase#34586, metabase#35129)
(update timeline-event :icon (fn [icon]
(if (= icon "balloons") default-icon icon)))) | |
permissions | |
(defmethod mi/perms-objects-set :model/TimelineEvent
[event read-or-write]
(let [timeline (or (:timeline event)
(t2/select-one 'Timeline :id (:timeline_id event)))]
(mi/perms-objects-set timeline read-or-write))) | |
hydration | |
(mi/define-simple-hydration-method timeline
:timeline
"Attach the parent `:timeline` to this [[TimelineEvent]]."
[{:keys [timeline_id]}]
(t2/select-one 'Timeline :id timeline_id)) | |
Fetch events for timelines in | (defn- fetch-events
[timeline-ids {:events/keys [all? start end]}]
(let [clause {:where [:and
;; in our collections
[:in :timeline_id timeline-ids]
(when-not all?
[:= :archived false])
(when (or start end)
[:or
;; absolute time in bounds
[:and
[:= :time_matters true]
;; less than or equal?
(when start
[:<= start :timestamp])
(when end
[:<= :timestamp end])]
;; non-specic time in bounds
[:and
[:= :time_matters false]
(when start
[:<= (h2x/->date start) (h2x/->date :timestamp)])
(when end
[:<= (h2x/->date :timestamp) (h2x/->date end)])]])]}]
(t2/hydrate (t2/select TimelineEvent clause) :creator))) |
Include events on | (defn include-events
[timelines options]
(if-not (seq timelines)
[]
(let [timeline-id->events (->> (fetch-events (map :id timelines) options)
(group-by :timeline_id))]
(for [{:keys [id] :as timeline} timelines]
(let [events (timeline-id->events id)]
(when timeline
(assoc timeline :events (if events events [])))))))) |
Similar to [[include-events]] but allows for passing a single timeline not in a collection. | (defn include-events-singular
([timeline] (include-events-singular timeline {}))
([timeline options]
(first (include-events [timeline] options)))) |
model | |
(defmethod serdes/hash-fields :model/TimelineEvent [_timeline-event] [:name :timestamp (serdes/hydrated-hash :timeline) :created_at]) | |
serialization TimelineEvents are inlined under their Timelines, but we can reuse the [[load-one!]] logic using [[load-xform]]. | (defmethod serdes/load-xform "TimelineEvent" [event]
(-> event
serdes/load-xform-basics
(update :timeline_id serdes/*import-fk* 'Timeline)
(update :creator_id serdes/*import-user*)
(update :timestamp u.date/parse)
(update :created_at #(if (string? %) (u.date/parse %) %)))) |
(ns metabase.models.user
(:require
[clojure.data :as data]
[clojure.string :as str]
[metabase.api.common :as api]
[metabase.config :as config]
[metabase.db.query :as mdb.query]
[metabase.events :as events]
[metabase.integrations.common :as integrations.common]
[metabase.models.audit-log :as audit-log]
[metabase.models.collection :as collection]
[metabase.models.interface :as mi]
[metabase.models.permissions :as perms]
[metabase.models.permissions-group :as perms-group]
[metabase.models.permissions-group-membership
:as perms-group-membership
:refer [PermissionsGroupMembership]]
[metabase.models.serialization :as serdes]
[metabase.models.session :refer [Session]]
[metabase.models.setting :as setting :refer [defsetting]]
[metabase.plugins.classloader :as classloader]
[metabase.public-settings :as public-settings]
[metabase.public-settings.premium-features :as premium-features]
[metabase.util :as u]
[metabase.util.i18n :as i18n :refer [deferred-tru trs tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[metabase.util.password :as u.password]
[methodical.core :as methodical]
[toucan2.core :as t2]
[toucan2.tools.default-fields :as t2.default-fields])) | |
(set! *warn-on-reflection* true) | |
----------------------------------------------- Entity & Lifecycle ----------------------------------------------- | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase. | (def User :model/User) |
(methodical/defmethod t2/table-name :model/User [_model] :core_user) (methodical/defmethod t2/model-for-automagic-hydration [:default :author] [_original-model _k] :model/User) (methodical/defmethod t2/model-for-automagic-hydration [:default :creator] [_original-model _k] :model/User) (methodical/defmethod t2/model-for-automagic-hydration [:default :updated_by] [_original-model _k] :model/User) (methodical/defmethod t2/model-for-automagic-hydration [:default :user] [_original-model _k] :model/User) | |
(doto :model/User (derive :metabase/model) (derive :hook/updated-at-timestamped?)) | |
(t2/deftransforms :model/User
{:login_attributes mi/transform-json-no-keywordization
:settings mi/transform-encrypted-json
:sso_source mi/transform-keyword
:type mi/transform-keyword}) | |
(def ^:private allowed-user-types
#{:internal :personal :api-key}) | |
(def ^:private insert-default-values
{:date_joined :%now
:last_login nil
:is_active true
:is_superuser false}) | |
When User | (defn- hashed-password-values
[{:keys [password], :as user}]
(when password
(assert (not (:password_salt user))
;; this is dev-facing so it doesn't need to be i18n'ed
"Don't try to pass an encrypted password to insert! or update!. Password encryption is handled by pre- methods.")
(let [salt (str (random-uuid))]
{:password_salt salt
:password (u.password/hash-bcrypt (str salt password))}))) |
Returns the user's settings (defaulting to an empty map) or | (defn user-local-settings
[user-or-user-id]
(when user-or-user-id
(or
(if (integer? user-or-user-id)
(:settings (t2/select-one [User :settings] :id user-or-user-id))
(:settings user-or-user-id))
{}))) |
(t2/define-before-insert :model/User
[{:keys [email password reset_token locale], :as user}]
;; these assertions aren't meant to be user-facing, the API endpoints should be validation these as well.
(assert (u/email? email))
(assert ((every-pred string? (complement str/blank?)) password))
(when-let [user-type (:type user)]
(assert
(contains? allowed-user-types user-type)))
(when locale
(assert (i18n/available-locale? locale) (tru "Invalid locale: {0}" (pr-str locale))))
(merge
insert-default-values
user
(hashed-password-values user)
;; lower-case the email before saving
{:email (u/lower-case-en email)}
;; if there's a reset token encrypt that as well
(when reset_token
{:reset_token (u.password/hash-bcrypt reset_token)})
;; normalize the locale
(when locale
{:locale (i18n/normalized-locale-string locale)}))) | |
(t2/define-after-insert :model/User
[{user-id :id, superuser? :is_superuser, :as user}]
(u/prog1 user
(let [current-version (:tag config/mb-version-info)]
(log/info (trs "Setting User {0}''s last_acknowledged_version to {1}, the current version" user-id current-version))
;; Can't use mw.session/with-current-user due to circular require
(binding [api/*current-user-id* user-id
setting/*user-local-values* (delay (atom (user-local-settings user)))]
(setting/set! :last-acknowledged-version current-version)))
;; add the newly created user to the magic perms groups.
(log/info (trs "Adding User {0} to All Users permissions group..." user-id))
(when superuser?
(log/info (trs "Adding User {0} to All Users permissions group..." user-id)))
(let [groups (filter some? [(perms-group/all-users)
(when superuser? (perms-group/admin))])]
(binding [perms-group-membership/*allow-changing-all-users-group-members* true]
;; do a 'simple' insert against the Table name so we don't trigger the after-insert behavior
;; for [[metabase.models.permissions-group-membership]]... we don't want it recursively trying to update
;; the user
(t2/insert! (t2/table-name :model/PermissionsGroupMembership)
(for [group groups]
{:user_id user-id
:group_id (u/the-id group)})))))) | |
(t2/define-before-update :model/User
[{:keys [id] :as user}]
;; when `:is_superuser` is toggled add or remove the user from the 'Admin' group as appropriate
(let [{reset-token :reset_token
superuser? :is_superuser
active? :is_active
:keys [email locale]} (t2/changes user)
in-admin-group? (t2/exists? PermissionsGroupMembership
:group_id (:id (perms-group/admin))
:user_id id)]
;; Do not let the last admin archive themselves
(when (and in-admin-group?
(false? active?))
(perms-group-membership/throw-if-last-admin!))
(when (some? superuser?)
(cond
(and superuser?
(not in-admin-group?))
(t2/insert! (t2/table-name PermissionsGroupMembership)
:group_id (u/the-id (perms-group/admin))
:user_id id)
;; don't use [[t2/delete!]] here because that does the opposite and tries to update this user which leads to a
;; stack overflow of calls between the two. TODO - could we fix this issue by using a `post-delete` method?
(and (not superuser?)
in-admin-group?)
(t2/delete! (t2/table-name PermissionsGroupMembership)
:group_id (u/the-id (perms-group/admin))
:user_id id)))
;; make sure email and locale are valid if set
(when email
(assert (u/email? email)))
(when locale
(assert (i18n/available-locale? locale) (tru "Invalid locale: {0}" (pr-str locale))))
;; delete all subscriptions to pulses/alerts/etc. if the User is getting archived (`:is_active` status changes)
(when (false? active?)
(t2/delete! 'PulseChannelRecipient :user_id id))
;; If we're setting the reset_token then encrypt it before it goes into the DB
(cond-> user
true (merge (hashed-password-values (t2/changes user)))
reset-token (update :reset_token u.password/hash-bcrypt)
locale (update :locale i18n/normalized-locale-string)
email (update :email u/lower-case-en)))) | |
Conditionally add a | (defn add-common-name
[{:keys [first_name last_name email], :as user}]
(let [common-name (if (or first_name last_name)
(str/trim (str first_name " " last_name))
email)]
(cond-> user
(and (contains? user :first_name)
(contains? user :last_name)
common-name)
(assoc :common_name common-name)))) |
(t2/define-after-select :model/User [user] (add-common-name user)) | |
Sequence of columns that are normally returned when fetching a User from the DB. | (def ^:private default-user-columns [:id :email :date_joined :first_name :last_name :last_login :is_superuser :is_qbnewb]) |
Sequence of columns that we can/should return for admins fetching a list of all Users, or for the current user fetching themselves. Needed to power the admin page. | (def admin-or-self-visible-columns (into default-user-columns [:sso_source :is_active :updated_at :login_attributes :locale])) |
Sequence of columns that we will allow non-admin Users to see when fetching a list of Users. Why can non-admins see other Users at all? I honestly would prefer they couldn't, but we need to give them a list of emails to power Pulses. | (def non-admin-or-self-visible-columns [:id :email :first_name :last_name]) |
Sequence of columns Group Managers can see when fetching a list of Users.. | (def group-manager-visible-columns (into non-admin-or-self-visible-columns [:is_superuser :last_login])) |
(t2.default-fields/define-default-fields :model/User default-user-columns) | |
(defmethod serdes/hash-fields User [_user] [:email]) | |
Fetch set of IDs of PermissionsGroup a User belongs to. | (defn group-ids
[user-or-id]
(when user-or-id
(t2/select-fn-set :group_id PermissionsGroupMembership :user_id (u/the-id user-or-id)))) |
Group Membership info of a User.
In which :isgroupmanager is only included if | (def UserGroupMembership
[:map
[:id ms/PositiveInt]
;; is_group_manager only included if `advanced-permissions` is enabled
[:is_group_manager {:optional true} :boolean]]) |
-------------------------------------------------- Permissions --------------------------------------------------- | |
Return a set of all permissions object paths that | (defn permissions-set
[user-or-id]
(set (when-let [user-id (u/the-id user-or-id)]
(concat
;; Current User always gets readwrite perms for their Personal Collection and for its descendants! (1 DB Call)
(map perms/collection-readwrite-path (collection/user->personal-collection-and-descendant-ids user-or-id))
;; include the other Perms entries for any Group this User is in (1 DB Call)
(map :object (mdb.query/query {:select [:p.object]
:from [[:permissions_group_membership :pgm]]
:join [[:permissions_group :pg] [:= :pgm.group_id :pg.id]
[:permissions :p] [:= :p.group_id :pg.id]]
:where [:= :pgm.user_id user-id]})))))) |
--------------------------------------------------- Hydration ---------------------------------------------------- | |
(mi/define-batched-hydration-method add-user-group-memberships
:user_group_memberships
"Add to each `user` a list of Group Memberships Info with each item is a map with 2 keys [:id :is_group_manager].
In which `is_group_manager` is only added when `advanced-permissions` is enabled."
[users]
(when (seq users)
(let [user-id->memberships (group-by :user_id (t2/select [PermissionsGroupMembership :user_id [:group_id :id] :is_group_manager]
:user_id [:in (set (map u/the-id users))]))
membership->group (fn [membership]
(select-keys membership
[:id (when (premium-features/enable-advanced-permissions?)
:is_group_manager)]))]
(for [user users]
(assoc user :user_group_memberships (map membership->group (user-id->memberships (u/the-id user)))))))) | |
(mi/define-batched-hydration-method add-group-ids
:group_ids
"Efficiently add PermissionsGroup `group_ids` to a collection of `users`.
TODO: deprecate :group_ids and use :user_group_memberships instead"
[users]
(when (seq users)
(let [user-id->memberships (group-by :user_id (t2/select [PermissionsGroupMembership :user_id :group_id]
:user_id [:in (set (map u/the-id users))]))]
(for [user users]
(assoc user :group_ids (set (map :group_id (user-id->memberships (u/the-id user))))))))) | |
(mi/define-batched-hydration-method add-has-invited-second-user
:has_invited_second_user
"Adds the `has_invited_second_user` flag to a collection of `users`. This should be `true` for only the user who
underwent the initial app setup flow (with an ID of 1), iff more than one user exists. This is used to modify
the wording for this user on a homepage banner that prompts them to add their database."
[users]
(when (seq users)
(let [user-count (t2/count User)]
(for [user users]
(assoc user :has_invited_second_user (and (= (:id user) 1)
(> user-count 1))))))) | |
(mi/define-batched-hydration-method add-is-installer
:is_installer
"Adds the `is_installer` flag to a collection of `users`. This should be `true` for only the user who
underwent the initial app setup flow (with an ID of 1). This is used to modify the experience of the
starting page for users."
[users]
(when (seq users)
(for [user users]
(assoc user :is_installer (= (:id user) 1))))) | |
--------------------------------------------------- Helper Fns --------------------------------------------------- | |
(declare form-password-reset-url set-password-reset-token!) | |
(defn- send-welcome-email! [new-user invitor sent-from-setup?]
(let [reset-token (set-password-reset-token! (u/the-id new-user))
should-link-to-login-page (and (public-settings/sso-enabled?)
(not (public-settings/enable-password-login)))
join-url (if should-link-to-login-page
(str (public-settings/site-url) "/auth/login")
;; NOTE: the new user join url is just a password reset with an indicator that this is a first time user
(str (form-password-reset-url reset-token) "#new"))]
(classloader/require 'metabase.email.messages)
((resolve 'metabase.email.messages/send-new-user-email!) new-user invitor join-url sent-from-setup?))) | |
Login attributes, currently not collected for LDAP or Google Auth. Will ultimately be stored as JSON. | (def LoginAttributes
(mu/with-api-error-message
[:map-of ms/KeywordOrString :any]
(deferred-tru "login attribute keys must be a keyword or string"))) |
Required/optionals parameters needed to create a new user (for any backend) | (def NewUser
[:map
[:first_name {:optional true} [:maybe ms/NonBlankString]]
[:last_name {:optional true} [:maybe ms/NonBlankString]]
[:email ms/Email]
[:password {:optional true} [:maybe ms/NonBlankString]]
[:login_attributes {:optional true} [:maybe LoginAttributes]]
[:sso_source {:optional true} [:maybe ms/NonBlankString]]
[:type {:optional true} [:maybe ms/KeywordOrString]]]) |
Map with info about the admin creating the user, used in the new user notification code | (def ^:private Invitor [:map [:email ms/Email] [:first_name [:maybe ms/NonBlankString]]]) |
Creates a new user, defaulting the password when not provided | (mu/defn ^:private insert-new-user! [new-user :- NewUser] (first (t2/insert-returning-instances! User (update new-user :password #(or % (str (random-uuid))))))) |
Creates a new user with a default password, when deserializing eg. a | (defn serdes-synthesize-user! [new-user] (insert-new-user! new-user)) |
Convenience function for inviting a new | (mu/defn create-and-invite-user!
[new-user :- NewUser invitor :- Invitor setup? :- :boolean]
;; create the new user
(u/prog1 (insert-new-user! new-user)
(events/publish-event! :event/user-invited
{:object
(assoc <>
:invite_method "email"
:sso_source (:sso_source new-user))})
(send-welcome-email! <> invitor setup?))) |
Convenience for creating a new user via Google Auth. This account is considered active immediately; thus all active admins will receive an email right away. | (mu/defn create-new-google-auth-user!
[new-user :- NewUser]
(u/prog1 (insert-new-user! (assoc new-user :sso_source "google"))
;; send an email to everyone including the site admin if that's set
(when (integrations.common/send-new-sso-user-admin-email?)
(classloader/require 'metabase.email.messages)
((resolve 'metabase.email.messages/send-user-joined-admin-notification-email!) <>, :google-auth? true)))) |
Convenience for creating a new user via LDAP. This account is considered active immediately; thus all active admins will receive an email right away. | (mu/defn create-new-ldap-auth-user!
[new-user :- NewUser]
(insert-new-user!
(-> new-user
;; We should not store LDAP passwords
(dissoc :password)
(assoc :sso_source "ldap")))) |
Update the stored password for a specified The password is automatically hashed with a random salt; this happens in [[hashed-password-values]] which is called by [[pre-insert]] or [[pre-update]]) TODO -- it seems like maybe this should just be part of the [[pre-update]] logic whenever | (defn set-password!
[user-id password]
;; when changing/resetting the password, kill any existing sessions
(t2/delete! (t2/table-name Session) :user_id user-id)
;; NOTE: any password change expires the password reset token
(t2/update! User user-id
{:password password
:reset_token nil
:reset_triggered nil})) |
Updates a given | (defn set-password-reset-token!
[user-id]
{:pre [(integer? user-id)]}
(u/prog1 (str user-id \_ (random-uuid))
(t2/update! User user-id
{:reset_token <>
:reset_triggered (System/currentTimeMillis)}))) |
Generate a properly formed password reset url given a password reset token. | (defn form-password-reset-url
[reset-token]
{:pre [(string? reset-token)]}
(str (public-settings/site-url) "/auth/reset_password/" reset-token)) |
Set the user's group memberships to equal the supplied group IDs. Returns | (defn set-permissions-groups!
[user-or-id new-groups-or-ids]
(let [user-id (u/the-id user-or-id)
old-group-ids (group-ids user-id)
new-group-ids (set (map u/the-id new-groups-or-ids))
[to-remove to-add] (data/diff old-group-ids new-group-ids)]
(when (seq (concat to-remove to-add))
(t2/with-transaction [_conn]
(when (seq to-remove)
(t2/delete! PermissionsGroupMembership :user_id user-id, :group_id [:in to-remove]))
;; a little inefficient, but we need to do a separate `insert!` for each group we're adding membership to,
;; because `insert-many!` does not currently trigger methods such as `pre-insert`. We rely on those methods to
;; do things like automatically set the `is_superuser` flag for a User
;; TODO use multipel insert here
(doseq [group-id to-add]
(t2/insert! PermissionsGroupMembership {:user_id user-id, :group_id group-id}))))
true)) |
---------------------------------------- USER SETTINGS ---------------------------------------- | |
NB: Settings are also defined where they're used, such as in metabase.events.view-log | |
(defsetting last-acknowledged-version (deferred-tru "The last version for which a user dismissed the 'What's new?' modal.") :user-local :only :type :string) | |
------------------------------------------ AUDIT LOG ------------------------------------------ | |
(defmethod audit-log/model-details :model/User
[entity event-type]
(case event-type
:user-update (select-keys (t2/hydrate entity :user_group_memberships)
[:groups :first_name :last_name :email
:invite_method :sso_source
:user_group_memberships])
:user-invited (select-keys (t2/hydrate entity :user_group_memberships)
[:groups :first_name :last_name :email
:invite_method :sso_source
:user_group_memberships])
:password-reset-initiated (select-keys entity [:token])
:password-reset-successful (select-keys entity [:token])
{})) | |
The ViewLog is used to log an event where a given User views a given object such as a Table or Card (Question). | (ns metabase.models.view-log (:require [metabase.models.interface :as mi] [methodical.core :as m] [toucan2.core :as t2])) |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase. | (def ViewLog :model/ViewLog) |
(m/defmethod t2/table-name :model/ViewLog [_model] :view_log) | |
(doto ViewLog (derive :metabase/model) (derive ::mi/read-policy.always-allow) (derive ::mi/write-policy.always-allow)) | |
(t2/define-before-insert :model/ViewLog
[log-entry]
(let [defaults {:timestamp :%now}]
(merge defaults log-entry))) | |
(t2/deftransforms :model/ViewLog
{:metadata mi/transform-json}) | |
(ns metabase.moderation (:require [medley.core :as m] [metabase.models.interface :as mi] [metabase.util :as u] [toucan2.core :as t2])) | |
Schema enum of the acceptable values for the | (def moderated-item-types [:enum "card" :card]) |
Maps DB name of the moderated item type to the model symbol (used for t2/select and such) | (def moderated-item-type->model
{"card" 'Card
:card 'Card}) |
Convert a moderated item instance to the keyword stored in the database | (defn- object->type [instance] (u/lower-case-en (name (t2/model instance)))) |
(mi/define-batched-hydration-method moderation-reviews-for-items
:moderation_reviews
"Hydrate moderation reviews onto a seq of items. All are cards or the nils that end up here on text dashboard
cards. In the future could have dashboards here as well."
[items]
;; no need to do work on empty items. Also, can have nil here due to text cards. I think this is a bug in toucan. To
;; get here we are `(t2/hydrate dashboard [:dashcards [:card :moderation_reviews] :series] ...)` But dashcards
;; dont have to have cards. but the hydration will pass the nil card id into here. NOTE: it is important that each
;; item that comes into this comes out. The nested hydration is positional, not by an id so everything that comes in
;; must go out in the same order
(when (seq items)
(let [item-ids (not-empty (keep :id items))
all-reviews (when item-ids
(group-by (juxt :moderated_item_type :moderated_item_id)
(t2/select 'ModerationReview
:moderated_item_type "card"
:moderated_item_id [:in item-ids]
{:order-by [[:id :desc]]})))]
(for [item items]
(if (nil? item)
nil
(let [k ((juxt (comp keyword object->type) u/the-id) item)]
(assoc item :moderation_reviews (get all-reviews k ())))))))) | |
(mi/define-batched-hydration-method moderation-user-details
:moderator_details
"User details on moderation reviews"
[moderation-reviews]
(when (seq moderation-reviews)
(let [id->user (m/index-by :id
(t2/select 'User :id [:in (map :moderator_id moderation-reviews)]))]
(for [mr moderation-reviews]
(assoc mr :user (get id->user (:moderator_id mr))))))) | |
(mi/define-simple-hydration-method moderated-item
:moderated_item
"The moderated item for a given request or review"
[{:keys [moderated_item_id moderated_item_type]}]
(when (and moderated_item_type moderated_item_id)
(t2/select-one (moderated-item-type->model moderated_item_type) :id moderated_item_id))) | |
Utilities for working with permissions, particularly the permission paths which are stored in the DB. These should
typically not be used outside of permissions-related namespaces such as | (ns metabase.permissions.util (:require [clojure.string :as str] [malli.core :as mc] [metabase.util.malli :as mu] [metabase.util.regex :as u.regex])) |
+----------------------------------------------------------------------------------------------------------------+ | PATH CLASSIFICATION + VALIDATION | +----------------------------------------------------------------------------------------------------------------+ | |
Regex for a valid character for a name that appears in a permissions path (e.g. a schema name or a Collection name).
Character is valid if it is either:
1. Any character other than a slash
2. A forward slash, escaped by a backslash: | (def path-char-rx
"Regex for a valid character for a name that appears in a permissions path (e.g. a schema name or a Collection name).
Character is valid if it is either:
1. Any character other than a slash
2. A forward slash, escaped by a backslash: `\\/`
3. A backslash escaped by a backslash: `\\\\`"
(u.regex/rx [:or #"[^\\/]" #"\\/" #"\\\\"])) |
(def ^:private data-rx->data-kind
{ #"db/\d+/" :dk/db
[:and #"db/\d+/" "native" "/"] :dk/db-native
[:and #"db/\d+/" "schema" "/"] :dk/db-schema
[:and #"db/\d+/" "schema" "/" path-char-rx "*" "/"] :dk/db-schema-name
[:and #"db/\d+/" "schema" "/" path-char-rx "*" "/table/\\d+/"] :dk/db-schema-name-and-table
[:and #"db/\d+/" "schema" "/" path-char-rx "*" "/table/\\d+/" "read/"] :dk/db-schema-name-table-and-read
[:and #"db/\d+/" "schema" "/" path-char-rx "*" "/table/\\d+/" "query/"] :dk/db-schema-name-table-and-query
[:and #"db/\d+/" "schema" "/" path-char-rx "*" "/table/\\d+/" "query/" "segmented/"] :dk/db-schema-name-table-and-segmented}) | |
(def ^:private DataKind (into [:enum] (vals data-rx->data-kind))) | |
*-permissions-rx The *-permissions-rx do not have anchors, since they get combined (and anchors placed around them) below. Take care to use anchors where they make sense. | |
Paths starting with /db/ is a DATA ACCESS permissions path Paths that do not start with /db/ (e.g. /download/db/...) do not involve granting data access, and are not data-permissions. They are other kinds of paths, for example: see [[download-permissions-rx]]. | (def v1-data-permissions-rx (into [:or] (keys data-rx->data-kind))) |
(def ^:private v2-data-permissions-rx [:and "data/" v1-data-permissions-rx]) (def ^:private v2-query-permissions-rx [:and "query/" v1-data-permissions-rx]) | |
Any path starting with /download/ is a DOWNLOAD permissions path /download/db/:id/ -> permissions to download 1M rows in query results /download/limited/db/:id/ -> permissions to download 1k rows in query results | (def ^:private download-permissions-rx
[:and "download/" [:? "limited/"]
[:and #"db/\d+/"
[:? [:or "native/"
[:and "schema/"
[:? [:and path-char-rx "*/"
[:? #"table/\d+/"]]]]]]]]) |
Any path starting with /data-model/ is a DATA MODEL permissions path /download/db/:id/ -> permissions to access the data model for the DB | (def ^:private data-model-permissions-rx
[:and "data-model/"
[:and #"db/\d+/"
[:? [:and "schema/"
[:? [:and path-char-rx "*/"
[:? #"table/\d+/"]]]]]]]) |
any path starting with /details/ is a DATABASE CONNECTION DETAILS permissions path /details/db/:id/ -> permissions to edit the connection details and settings for the DB | (def ^:private db-conn-details-permissions-rx [:and "details/" #"db/\d+/"]) |
.../execute/ -> permissions to run query actions in the DB | (def ^:private execute-permissions-rx [:and "execute/" [:or "" #"db/\d+/"]]) |
(def ^:private collection-permissions-rx
[:and "collection/"
[:or ;; /collection/:id/ -> readwrite perms for a specific Collection
[:and #"\d+/"
;; /collection/:id/read/ -> read perms for a specific Collection
[:? "read/"]]
;; /collection/root/ -> readwrite perms for the Root Collection
[:and "root/"
;; /collection/root/read/ -> read perms for the Root Collection
[:? "read/"]]
;; /collection/namespace/:namespace/root/ -> readwrite perms for 'Root' Collection in non-default
;; namespace (only really used for EE)
[:and "namespace/" path-char-rx "+/root/"
;; /collection/namespace/:namespace/root/read/ -> read perms for 'Root' Collection in
;; non-default namespace
[:? "read/"]]]]) | |
Any path starting with /application is a permissions that is not scoped by database or collection /application/setting/ -> permissions to access /admin/settings page /application/monitoring/ -> permissions to access tools, audit and troubleshooting /application/subscription/ -> permisisons to create/edit subscriptions and alerts | (def ^:private non-scoped-permissions-rx [:and "application/" [:or "setting/" "monitoring/" "subscription/"]]) |
Any path starting with /block/ is for BLOCK aka anti-permissions. currently only supported at the DB level. e.g. /block/db/1/ => block collection-based access to Database 1 | (def ^:private block-permissions-rx #"block/db/\d+/") |
Root Permissions, i.e. for admin | (def ^:private admin-permissions-rx "") |
Regex for a valid permissions path. The [[metabase.util.regex/rx]] macro is used to make the big-and-hairy regex somewhat readable. | (def path-regex-v1
(u.regex/rx
"^/" [:or
v1-data-permissions-rx
download-permissions-rx
data-model-permissions-rx
db-conn-details-permissions-rx
execute-permissions-rx
collection-permissions-rx
non-scoped-permissions-rx
block-permissions-rx
admin-permissions-rx]
"$")) |
(def ^:private rx->kind [[(u.regex/rx "^/" v1-data-permissions-rx "$") :data] [(u.regex/rx "^/" v2-data-permissions-rx "$") :data-v2] [(u.regex/rx "^/" v2-query-permissions-rx "$") :query-v2] [(u.regex/rx "^/" download-permissions-rx "$") :download] [(u.regex/rx "^/" data-model-permissions-rx "$") :data-model] [(u.regex/rx "^/" db-conn-details-permissions-rx "$") :db-conn-details] [(u.regex/rx "^/" execute-permissions-rx "$") :execute] [(u.regex/rx "^/" collection-permissions-rx "$") :collection] [(u.regex/rx "^/" non-scoped-permissions-rx "$") :non-scoped] [(u.regex/rx "^/" block-permissions-rx "$") :block] [(u.regex/rx "^/" admin-permissions-rx "$") :admin]]) | |
Regex for a valid permissions path. built with [[metabase.util.regex/rx]] to make the big-and-hairy regex somewhat readable. Will not match: - a v1 data path like "/db/1" or "/db/1/" - a block path like "block/db/2/" | (def path-regex-v2
(u.regex/rx
"^/" [:or
v2-data-permissions-rx
v2-query-permissions-rx
download-permissions-rx
data-model-permissions-rx
db-conn-details-permissions-rx
execute-permissions-rx
collection-permissions-rx
non-scoped-permissions-rx
admin-permissions-rx]
"$")) |
A permission path. | (def Path
[:or {:title "Path"} [:re path-regex-v1] [:re path-regex-v2]]) |
(def ^:private Kind
(into [:enum {:title "Kind"}] (map second rx->kind))) | |
(mu/defn classify-path :- Kind
"Classifies a permission [[metabase.models.permissions/Path]] into a [[metabase.models.permissions/Kind]], or throws."
[path :- Path]
(let [result (keep (fn [[permission-rx kind]]
(when (re-matches (u.regex/rx permission-rx) path) kind))
rx->kind)]
(when-not (= 1 (count result))
(throw (ex-info (str "Unclassifiable path! " (pr-str {:path path :result result}))
{:path path :result result})))
(first result))) | |
A permissions path that's guaranteed to be a v1 data-permissions path | (def DataPath [:re (u.regex/rx "^/" v1-data-permissions-rx "$")]) |
(mu/defn classify-data-path :- DataKind
"Classifies data path permissions [[metabase.models.permissions/DataPath]] into a [[metabase.models.permissions/DataKind]]"
[data-path :- DataPath]
(let [result (keep (fn [[data-rx kind]]
(when (re-matches (u.regex/rx [:and "^/" data-rx]) data-path) kind))
data-rx->data-kind)]
(when-not (= 1 (count result))
(throw (ex-info "Unclassified data path!!" {:data-path data-path :result result})))
(first result))) | |
Is | (let [path-validator (mc/validator Path)]
(defn valid-path?
^Boolean [^String path]
(path-validator path))) |
Schema for a permissions path with a valid format. | (def PathSchema
[:re
{:error/message "Valid permissions path"}
(re-pattern (str "^/(" path-char-rx "*/)*$"))]) |
Is | (let [path-format-validator (mc/validator PathSchema)]
(defn valid-path-format?
^Boolean [^String path]
(path-format-validator path))) |
+----------------------------------------------------------------------------------------------------------------+ | PATH UTILS | +----------------------------------------------------------------------------------------------------------------+ | |
Escape slashes in something that might be passed as a string part of a permissions path (e.g. DB schema name or Collection name). (escape-path-component "a/b") ;-> "a\/b" | (defn escape-path-component
"Escape slashes in something that might be passed as a string part of a permissions path (e.g. DB schema name or
Collection name).
(escape-path-component \"a/b\") ;-> \"a\\/b\""
[s]
(some-> s
(str/replace #"\\" "\\\\\\\\") ; \ -> \\
(str/replace #"/" "\\\\/"))) ; / -> \/ |
lookup table to generate v2 query + data permission from a v1 data permission. | (letfn [(delete [s to-delete] (str/replace s to-delete ""))
(data-query-split [path] [(str "/data" path) (str "/query" path)])]
(def ^:private data-kind->rewrite-fn
{:dk/db data-query-split
:dk/db-native (fn [path] (data-query-split (delete path "native/")))
:dk/db-schema (fn [path] [(str "/data" (delete path "schema/")) (str "/query" path)])
:dk/db-schema-name data-query-split
:dk/db-schema-name-and-table data-query-split
:dk/db-schema-name-table-and-read (constantly [])
:dk/db-schema-name-table-and-query (fn [path] (data-query-split (delete path "query/")))
:dk/db-schema-name-table-and-segmented (fn [path] (data-query-split (delete path "query/segmented/")))})) |
(mu/defn ->v2-path :- [:vector [:re path-regex-v2]]
"Takes either a v1 or v2 path, and translates it into one or more v2 paths."
[path :- [:or [:re path-regex-v1] [:re path-regex-v2]]]
(let [kind (classify-path path)]
(case kind
:data (let [data-permission-kind (classify-data-path path)
rewrite-fn (data-kind->rewrite-fn data-permission-kind)]
(rewrite-fn path))
:admin ["/"]
:block []
;; for sake of idempotency, v2 perm-paths should be unchanged.
(:data-v2 :query-v2) [path]
;; other paths should be unchanged too.
[path]))) | |
(ns metabase.plugins (:require [clojure.core.memoize :as memoize] [clojure.java.classpath :as classpath] [clojure.java.io :as io] [clojure.string :as str] [environ.core :as env] [metabase.config :as config] [metabase.plugins.classloader :as classloader] [metabase.plugins.initialize :as plugins.init] [metabase.util.files :as u.files] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [metabase.util.yaml :as yaml]) (:import (java.io File) (java.nio.file Files Path))) | |
(set! *warn-on-reflection* true) | |
(defn- plugins-dir-filename ^String []
(or (env/env :mb-plugins-dir)
(.getAbsolutePath (io/file "plugins")))) | |
(def ^:private plugins-dir*
;; Memoized so we don't log the error messages multiple times if the plugins directory doesn't change
(memoize/memo
(fn [filename]
(try
;; attempt to create <current-dir>/plugins if it doesn't already exist. Check that the directory is readable.
(let [path (u.files/get-path filename)]
(u.files/create-dir-if-not-exists! path)
(assert (Files/isWritable path)
(trs "Metabase does not have permissions to write to plugins directory {0}" filename))
{:path path, :temp false})
;; If we couldn't create the directory, or the directory is not writable, fall back to a temporary directory
;; rather than failing to launch entirely. Log instructions for what should be done to fix the problem.
(catch Throwable e
(log/warn
e
(trs "Metabase cannot use the plugins directory {0}" filename)
"\n"
(trs "Please make sure the directory exists and that Metabase has permission to write to it.")
(trs "You can change the directory Metabase uses for modules by setting the environment variable MB_PLUGINS_DIR.")
(trs "Falling back to a temporary directory for now."))
;; Check whether the fallback temporary directory is writable. If it's not, there's no way for us to
;; gracefully proceed here. Throw an Exception detailing the critical issues.
(let [path (u.files/get-path (System/getProperty "java.io.tmpdir"))]
(assert (Files/isWritable path)
(trs "Metabase cannot write to temporary directory. Please set MB_PLUGINS_DIR to a writable directory and restart Metabase."))
{:path path, :temp true})))))) | |
Map with a :path key containing the | (defn plugins-dir-info ^Path [] (plugins-dir* (plugins-dir-filename))) |
Get a This is a wrapper around | (defn plugins-dir [] (:path (plugins-dir-info))) |
(defn- extract-system-modules! []
(when (io/resource "modules")
(let [plugins-path (plugins-dir)]
(u.files/with-open-path-to-resource [modules-path "modules"]
(u.files/copy-files! modules-path plugins-path))))) | |
+----------------------------------------------------------------------------------------------------------------+ | loading/initializing plugins | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- add-to-classpath! [^Path jar-path] (classloader/add-url-to-classpath! (-> jar-path .toUri .toURL))) | |
(defn- plugin-info [^Path jar-path]
(some-> (u.files/slurp-file-from-archive jar-path "metabase-plugin.yaml")
yaml/parse-string)) | |
Initiaize plugin using parsed info from a plugin maifest. Returns truthy if plugin was successfully initialized; falsey otherwise. | (defn- init-plugin-with-info! [info] (plugins.init/init-plugin-with-info! info)) |
Init plugin JAR file; returns truthy if plugin initialization was successful. | (defn- init-plugin!
[^Path jar-path]
(if-let [info (plugin-info jar-path)]
;; for plugins that include a metabase-plugin.yaml manifest run the normal init steps, don't add to classpath yet
(init-plugin-with-info! (assoc info :add-to-classpath! #(add-to-classpath! jar-path)))
;; for all other JARs just add to classpath and call it a day
(add-to-classpath! jar-path))) |
+----------------------------------------------------------------------------------------------------------------+ | load-plugins! | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- plugins-paths []
(for [^Path path (u.files/files-seq (plugins-dir))
:when (and (u.files/regular-file? path)
(u.files/readable? path)
(str/ends-with? (.getFileName path) ".jar")
(or (not (str/ends-with? (.getFileName path) "spark-deps.jar"))
;; if the JAR in question is the spark deps JAR we cannot load it because it's signed, and
;; the Metabase JAR itself as well as plugins no longer are; Java will throw an Exception
;; if different JARs with `metabase` packages have different signing keys. Go ahead and
;; ignore it but let people know they can get rid of it.
(log/warn
(trs "spark-deps.jar is no longer needed by Metabase 0.32.0+. You can delete it from the plugins directory."))))]
path)) | |
Return a sequence of [[java.io.File]] paths for | (when (or config/is-dev? config/is-test?)
(defn- load-local-plugin-manifest! [^Path path]
(some-> (slurp (str path)) yaml/parse-string plugins.init/init-plugin-with-info!))
(defn- driver-manifest-paths
[]
;; only include plugin manifests if they're on the system classpath.
(concat
(for [^File file (classpath/system-classpath)
:when (and (.isDirectory file)
(not (.isHidden file))
(str/includes? (str file) "modules/drivers")
(or (str/ends-with? (str file) "resources")
(str/ends-with? (str file) "resources-ee")))
:let [manifest-file (io/file file "metabase-plugin.yaml")]
:when (.exists manifest-file)]
manifest-file)
;; for hacking on 3rd-party drivers locally: set
;; `-Dmb.dev.additional.driver.manifest.paths=/path/to/whatever/metabase-plugin.yaml` or
;; `MB_DEV_ADDITIONAL_DRIVER_MANIFEST_PATHS=...` to have that plugin manifest get loaded during startup. Specify
;; multiple plugin manifests by comma-separating them.
(when-let [additional-paths (env/env :mb-dev-additional-driver-manifest-paths)]
(map u.files/get-path (str/split additional-paths #",")))))
(defn- load-local-plugin-manifests!
[]
;; TODO - this should probably do an actual search in case we ever add any additional directories
(doseq [manifest-path (driver-manifest-paths)]
(log/info (trs "Loading local plugin manifest at {0}" (str manifest-path)))
(load-local-plugin-manifest! manifest-path)))) |
(defn- has-manifest? ^Boolean [^Path path] (boolean (u.files/file-exists-in-archive? path "metabase-plugin.yaml"))) | |
(defn- init-plugins! [paths]
;; sort paths so that ones that correspond to JARs with no plugin manifest (e.g. a dependency like the Oracle JDBC
;; driver `ojdbc8.jar`) always get initialized (i.e., added to the classpath) first; that way, Metabase drivers that
;; depend on them (such as Oracle) can be initialized the first time we see them.
;;
;; In Clojure world at least `false` < `true` so we can use `sort-by` to get non-Metabase-plugin JARs in front
(doseq [^Path path (sort-by has-manifest? paths)]
(try
(init-plugin! path)
(catch Throwable e
(log/error e (trs "Failied to initialize plugin {0}" (.getFileName path))))))) | |
(defn- load! []
(log/info (trs "Loading plugins in {0}..." (str (plugins-dir))))
(extract-system-modules!)
(let [paths (plugins-paths)]
(init-plugins! paths))
(when (or config/is-dev? config/is-test?)
(load-local-plugin-manifests!))) | |
(defonce ^:private loaded? (atom false)) | |
Load Metabase plugins. The are JARs shipped as part of Metabase itself, under the When loading plugins, Metabase performs the following steps:
This function will only perform loading steps the first time it is called — it is safe to call this function more than once. | (defn load-plugins!
[]
(when-not @loaded?
(locking loaded?
(when-not @loaded?
(load!)
(reset! loaded? true))))) |
Logic for getting and setting the context classloader we'll use for loading Metabase plugins. Use The classloader is guaranteed to be an instance of If you are unfamiliar with ClassLoaders in general, I found this article pretty helpful: https://www.javaworld.com/article/2077344/core-java/find-a-way-out-of-the-classloader-maze.html. <3 Cam | (ns metabase.plugins.classloader (:refer-clojure :exclude [require]) (:require [clojure.string :as str] [dynapath.util :as dynapath] [metabase.util.log :as log]) (:import (clojure.lang DynamicClassLoader RT) (java.net URL))) |
(set! *warn-on-reflection* true) | |
The context classloader we'll use for all threads, once we figure out what that is.
Guaranteed to be an instance of | (defonce ^:private shared-context-classloader
(delay
;; If the Clojure runtime base loader is already an instance of DynamicClassLoader (e.g. it is something like
;; `clojure.lang.Compiler/LOADER` we can go ahead and use that in the future. This is usually the case when doing
;; REPL-based development or running via the Clojure CLI; when running from the UberJAR
;; `clojure.lang.Compiler/LOADER` is not set and thus this will return the current thread's context classloader,
;; which is usually just the System classloader.
;;
;; The base loader is what Clojure ultimately uses to loading namespaces with `require` so adding URLs to it is
;; they way to go, if we can)
(or
(when-let [base-loader (RT/baseLoader)]
(when (instance? DynamicClassLoader base-loader)
(log/tracef "Using Clojure base loader as shared context classloader: %s" base-loader)
base-loader))
;; Otherwise if we need to create our own go ahead and do it
;;
;; Make a new classloader using the current thread's context classloader as it's parent. In cases where we hit
;; this condition (i.e., when running from the uberjar), the current thread's context classloader should be the
;; system classloader. Since it will be the same for other threads too it doesn't matter if we ignore *their*
;; context classloaders by giving them this one. No other places in the codebase should be modifying classloaders
;; anyway.
(let [new-classloader (DynamicClassLoader. (.getContextClassLoader (Thread/currentThread)))]
(log/tracef "Using NEWLY CREATED classloader as shared context classloader: %s" new-classloader)
new-classloader)))) |
True if | (defn- has-classloader-as-ancestor?
[^ClassLoader classloader, ^ClassLoader ancestor]
(cond
(identical? classloader ancestor)
true
classloader
(recur (.getParent classloader) ancestor)
:else
false)) |
True if the | (defn- has-shared-context-classloader-as-ancestor? [^ClassLoader classloader] (has-classloader-as-ancestor? classloader @shared-context-classloader)) |
Fetch the context classloader for the current thread; ensure it has a our shared context classloader as an ancestor somewhere in its hierarchy, changing the thread's context classloader when needed. This function should be used when loading classes (such as JDBC drivers) with | (defn the-classloader
^ClassLoader []
(or
;; if the context classloader already has the classloader we'll add URLs to as an ancestor return it as-is
(let [current-thread-context-classloader (.getContextClassLoader (Thread/currentThread))]
(when (has-shared-context-classloader-as-ancestor? current-thread-context-classloader)
current-thread-context-classloader))
;; otherwise set the current thread's context classloader to the shared context classloader
(let [shared-classloader @shared-context-classloader]
(log/tracef "Setting current thread context classloader to shared classloader %s..." shared-classloader)
(.setContextClassLoader (Thread/currentThread) shared-classloader)
shared-classloader))) |
Return a sequence of classloaders representing the hierarchy for | (defn- classloader-hierarchy [^ClassLoader classloader] (reverse (take-while some? (iterate #(.getParent ^ClassLoader %) classloader)))) |
Find the highest-level DynamicClassLoader, starting our search with the current thread's context classloader; the
classloader will be changed as needed by a call to This classloader is the one we'll add URLs to. Why? In nREPL-based usage, the REPL creates a new classloader for each statement, using the prior one as its parent; if we add URLs to the lowest classloader on the chain, any other threads using an ancestor classloader won't have the new URL. By adding the URL to the highest-level classloader we can, the current thread and other threads will be ultimately have access to that URL. | (defn- the-top-level-classloader
(^DynamicClassLoader []
(the-top-level-classloader (the-classloader)))
(^DynamicClassLoader [^DynamicClassLoader classloader]
(some #(when (instance? DynamicClassLoader %) %)
(classloader-hierarchy classloader)))) |
(defn- require* [& args]
;; during compilation, don't load any namespaces. This is going to totally screw up our compilation because
;; namespaces can end up being compiled twice because the topological sort in the build script doesn't take these
;; calls into account
(when-not *compile-files*
;; as elsewhere make sure Clojure is using our context classloader (which should normally be true anyway) because
;; that's the one that will have access to the JARs we've added to the classpath at runtime
;;
;; this is done for side-effects
(the-classloader)
(try
(binding [*use-context-classloader* true]
;; serialize requires
(locking clojure.lang.RT/REQUIRE_LOCK
(apply clojure.core/require args)))
(catch Throwable e
(throw (ex-info (.getMessage e)
{:classloader (the-classloader)
:classpath-urls (map str (dynapath/all-classpath-urls (the-classloader)))
:system-classpath (sort (str/split (System/getProperty "java.class.path") #"[:;]"))}
e)))))) | |
Just like vanilla Added benefit -- this is also thread-safe, unlike vanilla require. | (defn require
([x]
;; Check whether the lib is already loaded (we only do this in simple cases where with just one arg -- this is
;; most of the calls anyway). If the lib is already loaded we can skip acquiring the lock and expensive stuff like
;; bindings and the try-catch
(let [already-loaded? (and (symbol? x)
((loaded-libs) x))]
(when-not already-loaded?
(require* x))))
([x & more]
(apply require* x more))) |
(defonce ^:private already-added (atom #{})) | |
Add a URL (presumably for a local JAR) to the classpath. | (defn add-url-to-classpath!
[^URL url]
(when-not (@already-added url)
(swap! already-added conj url)
;; `add-classpath-url` will return non-truthy if it couldn't add the URL, e.g. because the classloader wasn't one
;; that allowed it
(assert (dynapath/add-classpath-url (the-top-level-classloader) url))
;; don't i18n this or we will have circular refs
(log/infof "Added URL %s to classpath" url))) |
(ns metabase.plugins.dependencies (:require [clojure.string :as str] [environ.core :as env] [metabase.plugins.classloader :as classloader] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log])) | |
(set! *warn-on-reflection* true) | |
(def ^:private plugins-with-unsatisfied-deps
(atom #{})) | |
(defn- dependency-type [{classname :class, plugin :plugin, env-var :env-var}]
(cond
classname :class
plugin :plugin
env-var :env-var
:else :unknown)) | |
(defmulti ^:private dependency-satisfied?
{:arglists '([initialized-plugin-names info dependency])}
(fn [_ _ dep] (dependency-type dep))) | |
(defmethod dependency-satisfied? :default [_ {{plugin-name :name} :info} dep]
(log/error
(u/format-color 'red
(trs "Plugin {0} declares a dependency that Metabase does not understand: {1}" plugin-name dep))
(trs "Refer to the plugin manifest reference for a complete list of valid plugin dependencies:")
"https://github.com/metabase/metabase/wiki/Metabase-Plugin-Manifest-Reference")
false) | |
(defonce ^:private already-logged (atom #{})) | |
Log a message a single time, such as warning that a plugin cannot be initialized because of required dependencies. Subsequent calls with duplicate messages are automatically ignored. | (defn log-once
{:style/indent 1}
([message]
(log-once nil message))
([plugin-name-or-nil message]
(let [k [plugin-name-or-nil message]]
(when-not (contains? @already-logged k)
(swap! already-logged conj k)
(log/info message))))) |
(defn- warn-about-required-dependencies [plugin-name message]
(log-once plugin-name
(str (u/format-color 'red (trs "Metabase cannot initialize plugin {0} due to required dependencies." plugin-name))
" "
message))) | |
(defmethod dependency-satisfied? :class
[_ {{plugin-name :name} :info} {^String classname :class, message :message, :as _dep}]
(try
(Class/forName classname false (classloader/the-classloader))
(catch ClassNotFoundException _
(warn-about-required-dependencies plugin-name (or message (trs "Class not found: {0}" classname)))
false))) | |
(defmethod dependency-satisfied? :plugin
[initialized-plugin-names {{plugin-name :name} :info} {dep-plugin-name :plugin}]
(log-once plugin-name (trs "Plugin ''{0}'' depends on plugin ''{1}''" plugin-name dep-plugin-name))
((set initialized-plugin-names) dep-plugin-name)) | |
(defmethod dependency-satisfied? :env-var
[_ {{plugin-name :name} :info} {env-var-name :env-var}]
(if (str/blank? (env/env (keyword env-var-name)))
(do
(log-once plugin-name (trs "Plugin ''{0}'' depends on environment variable ''{1}'' being set to something"
plugin-name
env-var-name))
false)
true)) | |
(defn- all-dependencies-satisfied?*
[initialized-plugin-names {:keys [dependencies], {plugin-name :name} :info, :as info}]
(let [dep-satisfied? (fn [dep]
(u/prog1 (dependency-satisfied? initialized-plugin-names info dep)
(log-once plugin-name
(trs "{0} dependency {1} satisfied? {2}" plugin-name (dissoc dep :message) (boolean <>)))))]
(every? dep-satisfied? dependencies))) | |
Check whether all dependencies are satisfied for a plugin; return truthy if all are; otherwise log explanations about why they are not, and return falsey. For plugins that might have their dependencies satisfied in the near future | (defn all-dependencies-satisfied?
[initialized-plugin-names info]
(or
(all-dependencies-satisfied?* initialized-plugin-names info)
(do
(swap! plugins-with-unsatisfied-deps conj info)
(log-once (u/format-color 'yellow
(trs "Plugins with unsatisfied deps: {0}" (mapv (comp :name :info) @plugins-with-unsatisfied-deps))))
false))) |
(defn- remove-plugins-with-satisfied-deps [plugins initialized-plugin-names ready-for-init-atom]
;; since `remove-plugins-with-satisfied-deps` could theoretically be called multiple times we need to reset the atom
;; used to return the plugins ready for init so we don't accidentally include something in there twice etc.
(reset! ready-for-init-atom nil)
(set
(for [info plugins
:let [ready? (when (all-dependencies-satisfied?* initialized-plugin-names info)
(swap! ready-for-init-atom conj info))]
:when (not ready?)]
info))) | |
Updates internal list of plugins that still have unmet dependencies; returns sequence of plugin infos for all plugins that are now ready for initialization. | (defn update-unsatisfied-deps!
[initialized-plugin-names]
(let [ready-for-init (atom nil)]
(swap! plugins-with-unsatisfied-deps remove-plugins-with-satisfied-deps initialized-plugin-names ready-for-init)
@ready-for-init)) |
Logic for performing the The entire list of possible init steps is below, as impls for the | (ns metabase.plugins.init-steps (:require [metabase.plugins.classloader :as classloader] [metabase.plugins.jdbc-proxy :as jdbc-proxy] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log])) |
Perform a driver init step. Steps are listed in | (defmulti ^:private do-init-step!
{:arglists '([m])}
(comp keyword :step)) |
(defmethod do-init-step! :load-namespace [{nmspace :namespace}]
(log/debug (u/format-color 'blue (trs "Loading plugin namespace {0}..." nmspace)))
(classloader/require (symbol nmspace))) | |
(defmethod do-init-step! :register-jdbc-driver [{class-name :class}]
(jdbc-proxy/create-and-register-proxy-driver! class-name)) | |
Perform the initialization steps for a Metabase plugin as specified under | (defn do-init-steps!
[init-steps]
(doseq [step init-steps]
(do-init-step! step))) |
Logic related to initializing plugins, i.e. running the Note that this is not the same thing as initializing drivers -- drivers are initialized lazily when first needed; this step on the other hand runs at launch time and sets up that lazy load logic. | (ns metabase.plugins.initialize (:require [metabase.plugins.dependencies :as deps] [metabase.plugins.init-steps :as init-steps] [metabase.plugins.lazy-loaded-driver :as lazy-loaded-driver] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [schema.core :as s])) |
(defonce ^:private initialized-plugin-names (atom #{})) | |
(defn- init!
[{:keys [add-to-classpath!], init-steps :init, {plugin-name :name} :info, driver-or-drivers :driver, :as info}]
{:pre [(string? plugin-name)]}
(when (deps/all-dependencies-satisfied? @initialized-plugin-names info)
;; for each driver, if it's lazy load, register a lazy-loaded placeholder driver
(let [drivers (u/one-or-many driver-or-drivers)]
(doseq [{:keys [lazy-load], :or {lazy-load true}, :as driver} drivers]
(when lazy-load
(lazy-loaded-driver/register-lazy-loaded-driver! (assoc info :driver driver))))
;; if *any* of the drivers is not lazy-load, initialize it now
(when (some false? (map :lazy-load drivers))
(when add-to-classpath!
(add-to-classpath!))
(init-steps/do-init-steps! init-steps)))
;; record this plugin as initialized and find any plugins ready to be initialized because depended on this one !
;;
;; Fun fact: we already have the `plugin-initialization-lock` if we're here so we don't need to worry about
;; getting it again
(let [plugins-ready-to-init (deps/update-unsatisfied-deps! (swap! initialized-plugin-names conj plugin-name))]
(when (seq plugins-ready-to-init)
(log/debug (u/format-color 'yellow (trs "Dependencies satisfied; these plugins will now be loaded: {0}"
(mapv (comp :name :info) plugins-ready-to-init)))))
(doseq [plugin-info plugins-ready-to-init]
(init! plugin-info)))
:ok)) | |
(defn- initialized? [{{plugin-name :name} :info}]
(@initialized-plugin-names plugin-name)) | |
Initialize plugin using parsed info from a plugin manifest. Returns truthy if plugin was successfully initialized; falsey otherwise. | (s/defn init-plugin-with-info!
[info :- {:info {:name s/Str, :version s/Str, s/Keyword s/Any}
s/Keyword s/Any}]
(or
(initialized? info)
(locking initialized-plugin-names
(or
(initialized? info)
(init! info))))) |
JDBC proxy driver used for drivers added at runtime. DriverManager refuses to recognize drivers that weren't loaded by the system classloader, so we need to wrap our drivers loaded at runtime with a proxy class loaded at launch time. | (ns metabase.plugins.jdbc-proxy (:require [metabase.plugins.classloader :as classloader] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [potemkin.types :as p.types] [pretty.core :refer [PrettyPrintable]]) (:import (java.sql Driver DriverManager))) |
(set! *warn-on-reflection* true) | |
-------------------------------------------------- Proxy Driver -------------------------------------------------- | |
TODO -- why not use | (p.types/defprotocol+ ^:private ProxyDriver
(wrapped-driver [this]
"Get the JDBC driver wrapped by a Metabase JDBC proxy driver.")) |
(defn- proxy-driver ^Driver [^Driver driver]
(reify
PrettyPrintable
(pretty [_]
(list 'proxy-driver driver))
ProxyDriver
(wrapped-driver [_]
driver)
Driver
(acceptsURL [_ url]
(.acceptsURL driver url))
(connect [_ url info]
(.connect driver url info))
(getMajorVersion [_]
(.getMajorVersion driver))
(getMinorVersion [_]
(.getMinorVersion driver))
(getParentLogger [_]
(.getParentLogger driver))
(getPropertyInfo [_ url info]
(.getPropertyInfo driver url info))
(jdbcCompliant [_]
(.jdbcCompliant driver)))) | |
Create a new JDBC proxy driver to wrap driver with This is necessary because the DriverManager will not recognize any drivers that are NOT loaded by the System ClassLoader. | (defn create-and-register-proxy-driver!
[^String class-name]
(let [klass (Class/forName class-name true (classloader/the-classloader))
loaded-by-system-classloader? (identical? (.getClassLoader klass) (ClassLoader/getSystemClassLoader))]
;; if the System ClassLoader loaded this class, don't create the proxy driver, because that can break things in
;; some situations -- Oracle for example doesn't seem to behave properly when you do this. This mainly affects dev
;; which merges driver dependencies into the core project deps.
(if loaded-by-system-classloader?
(log/debug (u/format-color 'cyan (trs "Not creating proxy JDBC driver for class {0} -- original driver was loaded by system ClassLoader"
class-name)))
(let [driver (proxy-driver (.newInstance klass))]
(log/debug (u/format-color 'blue (trs "Registering JDBC proxy driver for {0}..." class-name)))
(DriverManager/registerDriver driver)
;; deregister the non-proxy version of the driver so it doesn't try to handle our URLs. Most JDBC drivers register
;; themseleves when the classes are loaded
(doseq [driver (enumeration-seq (DriverManager/getDrivers))
:when (instance? klass driver)]
(log/debug (u/format-color 'cyan (trs "Deregistering original JDBC driver {0}..." driver)))
(DriverManager/deregisterDriver driver)))))) |
Implementation for a delayed-load driver that implements a few basic driver methods ( See https://github.com/metabase/metabase/wiki/Metabase-Plugin-Manifest-Reference for all the options allowed for a plugin manifest. | (ns metabase.plugins.lazy-loaded-driver (:require [metabase.driver :as driver] [metabase.driver.common :as driver.common] [metabase.plugins.init-steps :as init-steps] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log]) (:import (clojure.lang MultiFn))) |
(set! *warn-on-reflection* true) | |
(defn- parse-connection-property [prop]
(cond
(string? prop)
(or (driver.common/default-options (keyword prop))
(driver.common/default-connection-info-fields (keyword prop))
(throw (Exception. (trs "Default connection property {0} does not exist." prop))))
(not (map? prop))
(throw (Exception. (trs "Invalid connection property {0}: not a string or map." prop)))
(:merge prop)
(into {} (map parse-connection-property) (:merge prop))
:else
prop)) | |
Parse the connection properties included in the plugin manifest. These can be one of several things -- a key
referring to one of the default maps in | (defn- parse-connection-properties
[{:keys [connection-properties]}]
(->> (map parse-connection-property connection-properties)
(map u/one-or-many)
(apply concat))) |
(defn- make-initialize! [driver add-to-classpath! init-steps]
(fn [_]
;; First things first: add the driver to the classpath!
(when add-to-classpath!
(add-to-classpath!))
;; remove *this* implementation of `initialize!`, because as you will see below, we want to give
;; lazy-load drivers the option to implement `initialize!` and do other things, which means we need to
;; manually call it. When we do so we don't want to get stuck in an infinite loop of calls back to this
;; implementation
(remove-method driver/initialize! driver)
;; ok, do the init steps listed in the plugin mainfest
(u/profile (u/format-color 'magenta (trs "Load lazy loading driver {0}" driver))
(init-steps/do-init-steps! init-steps))
;; ok, now go ahead and call `driver/initialize!` a second time on the driver in case it actually has
;; an implementation of `initialize!` other than this one. If it does not, we'll just end up hitting
;; the default implementation, which is a no-op
(driver/initialize! driver))) | |
Register a basic shell of a Metabase driver using the information from its Metabase plugin | (defn register-lazy-loaded-driver!
[{:keys [add-to-classpath!]
init-steps :init
contact-info :contact-info
superseded-by :superseded-by
{driver-name :name, :keys [abstract display-name parent], :or {abstract false}, :as driver-info} :driver}]
{:pre [(map? driver-info)]}
(let [driver (keyword driver-name)
connection-props (parse-connection-properties driver-info)]
;; Make sure the driver has required properties like driver-name
(when-not (seq driver-name)
(throw (ex-info (trs "Cannot initialize plugin: missing required property `driver-name`")
driver-info)))
;; if someone forgot to include connection properties for a non-abstract driver throw them a bone and warn them
;; about it
(when (and (not abstract)
(empty? connection-props))
(log/warn
(u/format-color 'red (trs "Warning: plugin manifest for {0} does not include connection properties" driver))))
;; ok, now add implementations for the so-called "non-trivial" driver multimethods
(doseq [[^MultiFn multifn, f]
{driver/initialize! (make-initialize! driver add-to-classpath! init-steps)
driver/display-name (when display-name (constantly display-name))
driver/contact-info (constantly contact-info)
driver/connection-properties (constantly connection-props)
driver/superseded-by (constantly (keyword superseded-by))}]
(when f
(.addMethod multifn driver f)))
;; finally, register the Metabase driver
(log/debug (u/format-color 'magenta (trs "Registering lazy loading driver {0}..." driver)))
(driver/register! driver, :parent (set (map keyword (u/one-or-many parent))), :abstract? abstract))) |
(ns metabase.public-settings
(:require
[clojure.java.io :as io]
[clojure.string :as str]
[java-time.api :as t]
[metabase.api.common :as api]
[metabase.config :as config]
[metabase.models.interface :as mi]
[metabase.models.setting :as setting :refer [defsetting]]
[metabase.plugins.classloader :as classloader]
[metabase.public-settings.premium-features :as premium-features]
[metabase.util :as u]
[metabase.util.fonts :as u.fonts]
[metabase.util.i18n
:as i18n
:refer [available-locales-with-names deferred-tru trs tru]]
[metabase.util.log :as log]
[metabase.util.password :as u.password]
[toucan2.core :as t2])) | |
(set! *warn-on-reflection* true) | |
These modules register settings but are otherwise unused. They still must be imported. | (comment premium-features/keep-me) |
(defsetting application-name (deferred-tru "This will replace the word \"Metabase\" wherever it appears.") :visibility :public :export? true :type :string :audit :getter :feature :whitelabel :default "Metabase") | |
Returns the value of the [[application-name]] setting so setting docstrings can be generated during the compilation stage.
Use this instead of | (defn application-name-for-setting-descriptions
[]
(if *compile-files*
"Metabase"
(binding [setting/*disable-cache* true]
(application-name)))) |
(defn- google-auth-enabled? [] (boolean (setting/get :google-auth-enabled))) | |
(defn- ldap-enabled? [] (classloader/require 'metabase.api.ldap) ((resolve 'metabase.api.ldap/ldap-enabled))) | |
(defn- ee-sso-configured? []
(when config/ee-available?
(classloader/require 'metabase-enterprise.sso.integrations.sso-settings))
(when-let [varr (resolve 'metabase-enterprise.sso.integrations.sso-settings/other-sso-enabled?)]
(varr))) | |
Any SSO provider is configured and enabled | (defn sso-enabled?
[]
(or (google-auth-enabled?)
(ldap-enabled?)
(ee-sso-configured?))) |
(defsetting check-for-updates (deferred-tru "Identify when new versions of Metabase are available.") :type :boolean :audit :getter :default true) | |
(defsetting version-info
(deferred-tru "Information about available versions of Metabase.")
:type :json
:audit :never
:default {}
:doc false) | |
(defsetting version-info-last-checked (deferred-tru "Indicates when Metabase last checked for new versions.") :visibility :public :type :timestamp :audit :never :default nil :doc false) | |
(defsetting startup-time-millis (deferred-tru "The startup time in milliseconds") :visibility :public :type :double :audit :never :default 0.0 :doc false) | |
(defsetting site-name
(deferred-tru "The name used for this instance of {0}."
(application-name-for-setting-descriptions))
:default "Metabase"
:audit :getter
:visibility :settings-manager
:export? true) | |
(defsetting custom-homepage (deferred-tru "Pick a dashboard to serve as the homepage. If people lack permissions to view the selected dashboard, Metabase will redirect them to the default homepage. To revert to the default Metabase homepage, simply turn off the toggle.") :default false :type :boolean :audit :getter :visibility :public) | |
(defsetting custom-homepage-dashboard (deferred-tru "ID of dashboard to use as a homepage") :type :integer :visibility :public :audit :getter) | |
(defsetting dismissed-custom-dashboard-toast (deferred-tru "Toggle which is true after a user has dismissed the custom dashboard toast.") :user-local :only :visibility :authenticated :type :boolean :default false :audit :never) | |
Unique identifier used for this instance of {0}. This is set once and only once the first time it is fetched via its magic getter. Nice! | (defsetting site-uuid ;; Don't i18n this docstring because it's not user-facing! :) :visibility :authenticated :type :string :setter :none :init setting/random-uuid-str :doc false) |
In the interest of respecting everyone's privacy and keeping things as anonymous as possible we have a different
site-wide UUID that we use for the EE/premium features token feature check API calls. It works in fundamentally the
same way as [[site-uuid]] but should only be used by the token check logic
in [[metabase.public-settings.premium-features/fetch-token-status]]. ( | (defsetting site-uuid-for-premium-features-token-checks :visibility :internal :type :string :setter :none :init setting/random-uuid-str :doc false) |
A different site-wide UUID that we use for the version info fetching API calls. Do not use this for any other applications. (See [[site-uuid-for-premium-features-token-checks]] for more reasoning.) | (defsetting site-uuid-for-version-info-fetching :visibility :internal :type :string :setter :none :init setting/random-uuid-str) |
UUID that we use for generating urls users to unsubscribe from alerts. The hash is generated by hash(secretuuid + email + subscriptionid) = url. Do not use this for any other applications. (See #29955) | (defsetting site-uuid-for-unsubscribing-url :visibility :internal :type :string :setter :none :init setting/random-uuid-str) |
(defn- normalize-site-url [^String s]
(let [ ;; remove trailing slashes
s (str/replace s #"/$" )
;; add protocol if missing
s (if (str/starts-with? s "http")
s
(str "http://" s))]
;; check that the URL is valid
(when-not (u/url? s)
(throw (ex-info (tru "Invalid site URL: {0}" (pr-str s)) {:url (pr-str s)})))
s)) | |
(declare redirect-all-requests-to-https!) | |
This value is guaranteed to never have a trailing slash :D
It will also prepend | (defsetting site-url
(deferred-tru
(str "This URL is used for things like creating links in emails, auth redirects, and in some embedding scenarios, "
"so changing it could break functionality or get you locked out of this instance."))
:visibility :public
:audit :getter
:getter (fn []
(try
(some-> (setting/get-value-of-type :string :site-url) normalize-site-url)
(catch clojure.lang.ExceptionInfo e
(log/error e (trs "site-url is invalid; returning nil for now. Will be reset on next request.")))))
:setter (fn [new-value]
(let [new-value (some-> new-value normalize-site-url)
https? (some-> new-value (str/starts-with? "https:"))]
;; if the site URL isn't HTTPS then disable force HTTPS redirects if set
(when-not https?
(redirect-all-requests-to-https! false))
(setting/set-value-of-type! :string :site-url new-value)))) |
(defsetting site-locale
(deferred-tru
(str "The default language for all users across the {0} UI, system emails, pulses, and alerts. "
"Users can individually override this default language from their own account settings.")
(application-name-for-setting-descriptions))
:default "en"
:visibility :public
:export? true
:audit :getter
:getter (fn []
(let [value (setting/get-value-of-type :string :site-locale)]
(when (i18n/available-locale? value)
value)))
:setter (fn [new-value]
(when new-value
(when-not (i18n/available-locale? new-value)
(throw (ex-info (tru "Invalid locale {0}" (pr-str new-value)) {:status-code 400}))))
(setting/set-value-of-type! :string :site-locale (some-> new-value i18n/normalized-locale-string)))) | |
(defsetting admin-email (deferred-tru "The email address users should be referred to if they encounter a problem.") :visibility :authenticated :audit :getter) | |
(defsetting anon-tracking-enabled
(deferred-tru "Enable the collection of anonymous usage data in order to help {0} improve."
(application-name-for-setting-descriptions))
:type :boolean
:default true
:visibility :public
:audit :getter) | |
(defsetting ga-code (deferred-tru "Google Analytics tracking code.") :default "UA-60817802-1" :visibility :public :doc false) | |
(defsetting ga-enabled (deferred-tru "Boolean indicating whether analytics data should be sent to Google Analytics on the frontend") :type :boolean :setter :none :getter (fn [] (and config/is-prod? (anon-tracking-enabled))) :visibility :public :audit :never :doc false) | |
(defsetting map-tile-server-url
(deferred-tru "The map tile server URL template used in map visualizations, for example from OpenStreetMaps or MapBox.")
:default "https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png"
:visibility :public
:audit :getter) | |
Get the path of a given URL if the URL contains an origin. Otherwise make the landing-page a relative path. | (defn- coerce-to-relative-url
[landing-page]
(cond
(u/url? landing-page) (-> landing-page io/as-url .getPath)
(empty? landing-page) ""
(not (str/starts-with? landing-page "/")) (str "/" landing-page)
:else landing-page)) |
(defsetting landing-page
(deferred-tru "Default page to show people when they log in.")
:visibility :public
:export? true
:type :string
:default
:audit :getter
:setter (fn [new-landing-page]
(when new-landing-page
;; If the landing page is a valid URL or mailto, sms, or file, then check with if site-url has the same origin.
(when (and (or (re-matches #"^(mailto|sms|file):(.*)" new-landing-page) (u/url? new-landing-page))
(not (str/starts-with? new-landing-page (site-url))))
(throw (ex-info (tru "This field must be a relative URL.") {:status-code 400}))))
(setting/set-value-of-type! :string :landing-page (coerce-to-relative-url new-landing-page)))) | |
(defsetting enable-public-sharing (deferred-tru "Enable admins to create publicly viewable links (and embeddable iframes) for Questions and Dashboards?") :type :boolean :default false :visibility :authenticated :audit :getter) | |
(defsetting enable-nested-queries (deferred-tru "Allow using a saved question or Model as the source for other queries?") :type :boolean :default true :visibility :authenticated :export? true :audit :getter) | |
(defsetting enable-query-caching (deferred-tru "Enabling caching will save the results of queries that take a long time to run.") :type :boolean :default false :visibility :authenticated :audit :getter) | |
(defsetting persisted-models-enabled (deferred-tru "Allow persisting models into the source database.") :type :boolean :default false :visibility :public :export? true :audit :getter) | |
(defsetting persisted-model-refresh-cron-schedule (deferred-tru "cron syntax string to schedule refreshing persisted models.") :type :string :default "0 0 0/6 * * ? *" :visibility :admin :audit :getter) | |
Although depending on the database, we can support much larger cached values (1GB for PG, 2GB for H2 and 4GB for MySQL) we are not curretly setup to deal with data of that size. The datatypes we are using will hold this data in memory and will not truly be streaming. This is a global max in order to prevent our users from setting the caching value so high it becomes a performance issue. The value below represents 200MB | (def ^:private ^:const global-max-caching-kb (* 200 1024)) |
(defsetting query-caching-max-kb
(deferred-tru "The maximum size of the cache, per saved question, in kilobytes:")
;; (This size is a measurement of the length of *uncompressed* serialized result *rows*. The actual size of
;; the results as stored will vary somewhat, since this measurement doesn't include metadata returned with the
;; results, and doesn't consider whether the results are compressed, as the `:db` backend does.)
:type :integer
:default 1000
:audit :getter
:setter (fn [new-value]
(when (and new-value
(> (cond-> new-value
(string? new-value) Integer/parseInt)
global-max-caching-kb))
(throw (IllegalArgumentException.
(str
(tru "Failed setting `query-caching-max-kb` to {0}." new-value)
" "
(tru "Values greater than {0} ({1}) are not allowed."
global-max-caching-kb (u/format-bytes (* global-max-caching-kb 1024)))))))
(setting/set-value-of-type! :integer :query-caching-max-kb new-value))) | |
(defsetting query-caching-max-ttl (deferred-tru "The absolute maximum time to keep any cached query results, in seconds.") :type :double :default (* 60.0 60.0 24.0 100.0) ; 100 days :audit :getter) | |
TODO -- this isn't really a TTL at all. Consider renaming to something like | (defsetting query-caching-min-ttl
(deferred-tru "{0} will cache all saved questions with an average query execution time longer than this many seconds:"
(application-name-for-setting-descriptions))
:type :double
:default 60.0
:audit :getter) |
(defsetting query-caching-ttl-ratio
(deferred-tru
(str "To determine how long each saved question''s cached result should stick around, we take the query''s average "
"execution time and multiply that by whatever you input here. So if a query takes on average 2 minutes to run, "
"and you input 10 for your multiplier, its cache entry will persist for 20 minutes."))
:type :integer
:default 10
:audit :getter) | |
(defsetting notification-link-base-url (deferred-tru "By default \"Site Url\" is used in notification links, but can be overridden.") :visibility :internal :type :string :feature :whitelabel :audit :getter) | |
(defsetting deprecation-notice-version (deferred-tru "Metabase version for which a notice about usage of deprecated features has been shown.") :visibility :admin :doc false :audit :never) | |
(defsetting loading-message (deferred-tru "Message to show while a query is running.") :visibility :public :export? true :feature :whitelabel :type :keyword :default :doing-science :audit :getter) | |
(defsetting application-colors
(deferred-tru
(str "These are the primary colors used in charts and throughout {0}. "
"You might need to refresh your browser to see your changes take effect.")
(application-name-for-setting-descriptions))
:visibility :public
:export? true
:type :json
:feature :whitelabel
:default {}
:audit :getter) | |
(defsetting application-font
(deferred-tru "This will replace “Lato” as the font family.")
:visibility :public
:export? true
:type :string
:default "Lato"
:feature :whitelabel
:audit :getter
:setter (fn [new-value]
(when new-value
(when-not (u.fonts/available-font? new-value)
(throw (ex-info (tru "Invalid font {0}" (pr-str new-value)) {:status-code 400}))))
(setting/set-value-of-type! :string :application-font new-value))) | |
(defsetting application-font-files (deferred-tru "Tell us where to find the file for each font weight. You don’t need to include all of them, but it’ll look better if you do.") :visibility :public :export? true :type :json :audit :getter :feature :whitelabel) | |
The primary color, a.k.a. brand color | (defn application-color [] (or (:brand (application-colors)) "#509EE3")) |
The first 'Additional chart color' | (defn secondary-chart-color [] (or (:accent3 (application-colors)) "#EF8C8C")) |
(defsetting application-logo-url (deferred-tru "For best results, use an SVG file with a transparent background.") :visibility :public :export? true :type :string :audit :getter :feature :whitelabel :default "app/assets/img/logo.svg") | |
(defsetting application-favicon-url (deferred-tru "The url or image that you want to use as the favicon.") :visibility :public :export? true :type :string :audit :getter :feature :whitelabel :default "app/assets/img/favicon.ico") | |
(defsetting show-metabot (deferred-tru "Enables Metabot character on the home page") :visibility :public :export? true :type :boolean :audit :getter :feature :whitelabel :default true) | |
(defsetting show-lighthouse-illustration (deferred-tru "Display the lighthouse illustration on the home and login pages.") :visibility :public :export? true :type :boolean :audit :getter :feature :whitelabel :default true) | |
(def ^:private help-link-options
#{:metabase :hidden :custom}) | |
(defsetting help-link
(deferred-tru
(str
"Keyword setting to control whitelabeling of the help link. Valid values are `:metabase`, `:hidden`, and "
"`:custom`. If `:custom` is set, the help link will use the URL specified in the `help-link-custom-destination`, "
"or be hidden if it is not set."))
:type :keyword
:audit :getter
:visibility :public
:feature :whitelabel
:default :metabase
:setter (fn [value]
(when-not (help-link-options (keyword value))
(throw (ex-info (tru "Invalid help link option")
{:value value
:valid-options help-link-options})))
(setting/set-value-of-type! :keyword :help-link value))) | |
Checks that the provided URL is either a valid HTTP/HTTPS URL or a | (defn- validate-help-url
[url]
(let [validation-exception (ex-info (tru "Please make sure this is a valid URL")
{:url url})]
(if-let [matches (re-matches #"^mailto:(.*)" url)]
(when-not (u/email? (second matches))
(throw validation-exception))
(when-not (u/url? url)
(throw validation-exception))))) |
(defsetting help-link-custom-destination
(deferred-tru "Custom URL for the help link.")
:visibility :public
:type :string
:audit :getter
:feature :whitelabel
:setter (fn [new-value]
(let [new-value-string (str new-value)]
(validate-help-url new-value-string)
(setting/set-value-of-type! :string :help-link-custom-destination new-value-string)))) | |
(defsetting show-metabase-links (deferred-tru (str "Whether or not to display Metabase links outside admin settings.")) :type :boolean :default true :visibility :public :audit :getter :feature :whitelabel) | |
(defsetting enable-password-login
(deferred-tru "Allow logging in by email and password.")
:visibility :public
:type :boolean
:default true
:feature :disable-password-login
:audit :raw-value
:getter (fn []
;; if `:enable-password-login` has an *explict* (non-default) value, and SSO is configured, use that;
;; otherwise this always returns true.
(let [v (setting/get-value-of-type :boolean :enable-password-login)]
(if (and (some? v)
(sso-enabled?))
v
true)))) | |
(defsetting breakout-bins-num
(deferred-tru
(str "When using the default binning strategy and a number of bins is not provided, "
"this number will be used as the default."))
:type :integer
:export? true
:default 8
:audit :getter) | |
(defsetting breakout-bin-width
(deferred-tru
(str "When using the default binning strategy for a field of type Coordinate (such as Latitude and Longitude), "
"this number will be used as the default bin width (in degrees)."))
:type :double
:default 10.0
:audit :getter) | |
(defsetting custom-formatting
(deferred-tru "Object keyed by type, containing formatting settings")
:type :json
:export? true
:default {}
:visibility :public
:audit :getter) | |
(defsetting enable-xrays (deferred-tru "Allow users to explore data using X-rays") :type :boolean :default true :visibility :authenticated :export? true :audit :getter) | |
(defsetting show-homepage-data
(deferred-tru
(str "Whether or not to display data on the homepage. "
"Admins might turn this off in order to direct users to better content than raw data"))
:type :boolean
:default true
:visibility :authenticated
:export? true
:audit :getter) | |
(defsetting show-homepage-xrays
(deferred-tru
(str "Whether or not to display x-ray suggestions on the homepage. They will also be hidden if any dashboards are "
"pinned. Admins might hide this to direct users to better content than raw data"))
:type :boolean
:default true
:visibility :authenticated
:export? true
:audit :getter) | |
(defsetting show-homepage-pin-message
(deferred-tru
(str "Whether or not to display a message about pinning dashboards. It will also be hidden if any dashboards are "
"pinned. Admins might hide this to direct users to better content than raw data"))
:type :boolean
:default true
:visibility :authenticated
:export? true
:doc false
:audit :getter) | |
(defsetting source-address-header
(deferred-tru "Identify the source of HTTP requests by this header's value, instead of its remote address.")
:default "X-Forwarded-For"
:export? true
:audit :getter
:getter (fn [] (some-> (setting/get-value-of-type :string :source-address-header)
u/lower-case-en))) | |
If public sharing is disabled and | (defn remove-public-uuid-if-public-sharing-is-disabled
[object]
(if (and (:public_uuid object)
(not (enable-public-sharing)))
(assoc object :public_uuid nil)
object)) |
Available fonts | (defsetting available-fonts :visibility :public :export? true :setter :none :getter u.fonts/available-fonts :doc false) |
Available i18n locales | (defsetting available-locales :visibility :public :export? true :setter :none :getter available-locales-with-names :doc false) |
Available report timezone options | (defsetting available-timezones :visibility :public :export? true :setter :none :getter (comp sort t/available-zone-ids) :doc false) |
Whether this instance has a Sample Database database | (defsetting has-sample-database? :visibility :authenticated :setter :none :getter (fn [] (t2/exists? :model/Database, :is_sample true)) :doc false) |
Current password complexity requirements | (defsetting password-complexity :visibility :public :setter :none :getter u.password/active-password-complexity) |
(defsetting session-cookies (deferred-tru "When set, enforces the use of session cookies for all users which expire when the browser is closed.") :type :boolean :visibility :public :default nil :audit :getter) | |
Metabase's version info | (defsetting version :visibility :public :setter :none :getter (constantly config/mb-version-info) :doc false) |
Features registered for this instance's token | (defsetting token-features
:visibility :public
:setter :none
:getter (fn [] {:advanced_permissions (premium-features/enable-advanced-permissions?)
:audit_app (premium-features/enable-audit-app?)
:cache_granular_controls (premium-features/enable-cache-granular-controls?)
:config_text_file (premium-features/enable-config-text-file?)
:content_verification (premium-features/enable-content-verification?)
:dashboard_subscription_filters (premium-features/enable-dashboard-subscription-filters?)
:disable_password_login (premium-features/can-disable-password-login?)
:email_allow_list (premium-features/enable-email-allow-list?)
:email_restrict_recipients (premium-features/enable-email-restrict-recipients?)
:embedding (premium-features/hide-embed-branding?)
:hosting (premium-features/is-hosted?)
:official_collections (premium-features/enable-official-collections?)
:sandboxes (premium-features/enable-sandboxes?)
:session_timeout_config (premium-features/enable-session-timeout-config?)
:snippet_collections (premium-features/enable-snippet-collections?)
:sso_google (premium-features/enable-sso-google?)
:sso_jwt (premium-features/enable-sso-jwt?)
:sso_ldap (premium-features/enable-sso-ldap?)
:sso_saml (premium-features/enable-sso-saml?)
:whitelabel (premium-features/enable-whitelabeling?)})
:doc false) |
(defsetting redirect-all-requests-to-https
(deferred-tru "Force all traffic to use HTTPS via a redirect, if the site URL is HTTPS")
:visibility :public
:type :boolean
:default false
:audit :getter
:setter (fn [new-value]
;; if we're trying to enable this setting, make sure `site-url` is actually an HTTPS URL.
(when (if (string? new-value)
(setting/string->boolean new-value)
new-value)
(assert (some-> (site-url) (str/starts-with? "https:"))
(tru "Cannot redirect requests to HTTPS unless `site-url` is HTTPS.")))
(setting/set-value-of-type! :boolean :redirect-all-requests-to-https new-value))) | |
(defsetting start-of-week
(deferred-tru
(str "This will affect things like grouping by week or filtering in GUI queries. "
"It won''t affect most SQL queries, "
"although it is used to set the WEEK_START session variable in Snowflake."))
:visibility :public
:export? true
:type :keyword
:default :sunday
:audit :raw-value
:getter (fn []
;; if something invalid is somehow in the DB just fall back to Sunday
(when-let [value (setting/get-value-of-type :keyword :start-of-week)]
(if (#{:monday :tuesday :wednesday :thursday :friday :saturday :sunday} value)
value
:sunday)))
:setter (fn [new-value]
(when new-value
(assert (#{:monday :tuesday :wednesday :thursday :friday :saturday :sunday} (keyword new-value))
(trs "Invalid day of week: {0}" (pr-str new-value))))
(setting/set-value-of-type! :keyword :start-of-week new-value))) | |
(defsetting cloud-gateway-ips
(deferred-tru "Metabase Cloud gateway IP addresses, to configure connections to DBs behind firewalls")
:visibility :public
:type :string
:setter :none
:getter (fn []
(when (premium-features/is-hosted?)
(some-> (setting/get-value-of-type :string :cloud-gateway-ips)
(str/split #","))))) | |
(defsetting show-database-syncing-modal
(deferred-tru
(str "Whether an introductory modal should be shown after the next database connection is added. "
"Defaults to false if any non-default database has already finished syncing for this instance."))
:visibility :admin
:type :boolean
:audit :never
:getter (fn []
(let [v (setting/get-value-of-type :boolean :show-database-syncing-modal)]
(if (nil? v)
(not (t2/exists? :model/Database
:is_sample false
:is_audit false
:initial_sync_status "complete"))
;; frontend should set this value to `true` after the modal has been shown once
v)))) | |
(defsetting uploads-enabled (deferred-tru "Whether or not uploads are enabled") :visibility :authenticated :export? true :type :boolean :audit :getter :default false) | |
(defn- not-handling-api-request? [] (nil? @api/*current-user*)) | |
Sets the :uploads-database-id setting, with an appropriate permission check. | (defn set-uploads-database-id!
[new-id]
(if (or (not-handling-api-request?)
(mi/can-write? :model/Database new-id))
(setting/set-value-of-type! :integer :uploads-database-id new-id)
(api/throw-403))) |
(defsetting uploads-database-id (deferred-tru "Database ID for uploads") :visibility :authenticated :export? true :type :integer :audit :getter :setter set-uploads-database-id!) | |
(defsetting uploads-schema-name (deferred-tru "Schema name for uploads") :visibility :authenticated :export? true :type :string :audit :getter) | |
(defsetting uploads-table-prefix (deferred-tru "Prefix for upload table names") :visibility :authenticated :type :string :audit :getter) | |
(defsetting attachment-table-row-limit
(deferred-tru "Maximum number of rows to render in an alert or subscription image.")
:visibility :internal
:type :positive-integer
:default 20
:audit :getter
:getter (fn []
(let [value (setting/get-value-of-type :positive-integer :attachment-table-row-limit)]
(if-not (pos-int? value)
20
value)))) | |
Settings related to checking premium token validity and which premium features it allows. | (ns metabase.public-settings.premium-features (:require [cheshire.core :as json] [clj-http.client :as http] [clojure.core.memoize :as memoize] [clojure.spec.alpha :as s] [clojure.string :as str] [environ.core :refer [env]] [malli.core :as mc] [metabase.api.common :as api] [metabase.config :as config] [metabase.models.setting :as setting :refer [defsetting]] [metabase.plugins.classloader :as classloader] [metabase.util :as u] [metabase.util.i18n :refer [deferred-tru trs tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [metabase.util.string :as u.str] [toucan2.connection :as t2.conn] [toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
Schema for a valid premium token. Must be 64 lower-case hex characters. | (def ^:private ValidToken
#"^[0-9a-f]{64}$") |
Base URL to use for token checks. Hardcoded by default but for development purposes you can use a local server.
Specify the env var | (def token-check-url
(or
;; only enable the changing the token check url during dev because we don't want people switching it out in production!
(when config/is-dev?
(some-> (env :metastore-dev-server-url)
;; remove trailing slashes
(str/replace #"/$" "")))
"https://token-check.metabase.com")) |
Store URL, used as a fallback for token checks and for fetching the list of cloud gateway IPs. | (def store-url "https://store.metabase.com") |
+----------------------------------------------------------------------------------------------------------------+ | TOKEN VALIDATION | +----------------------------------------------------------------------------------------------------------------+ | |
(declare premium-embedding-token) | |
Primarily used for the settings because we don't wish it to be 100%. (HUH?) let's prevent the DB from getting slammed with calls to get the active user count, we only really need one in flight at a time. | (let [f (fn []
{:post [(integer? %)]}
(log/debug (u/colorize :yellow "GETTING ACTIVE USER COUNT!"))
(assert ((requiring-resolve 'metabase.db/db-is-set-up?)) "Metabase DB is not yet set up")
;; force this to use a new Connection, it seems to be getting called in situations where the Connection
;; is from a different thread and is invalid by the time we get to use it
(let [result (binding [t2.conn/*current-connectable* nil]
(t2/count :model/User :is_active true :type :personal))]
(log/debug (u/colorize :green "=>") result)
result))
memoized (memoize/ttl
f
:ttl/threshold (u/minutes->ms 5))
lock (Object.)]
(defn- cached-active-users-count
[]
(locking lock
(memoized)))) |
(defsetting active-users-count
(deferred-tru "Cached number of active users. Refresh every 5 minutes.")
:visibility :admin
:type :integer
:audit :never
:default 0
:getter (fn []
(if-not ((requiring-resolve 'metabase.db/db-is-set-up?))
0
(cached-active-users-count)))) | |
(defn- token-status-url [token base-url]
(when (seq token)
(format "%s/api/%s/v2/status" base-url token))) | |
(def ^:private ^:const fetch-token-status-timeout-ms (u/seconds->ms 10)) | |
(def ^:private TokenStatus
[:map
[:valid :boolean]
[:status ms/NonBlankString]
[:error-details {:optional true} [:maybe ms/NonBlankString]]
[:features {:optional true} [:sequential ms/NonBlankString]]
[:trial {:optional true} :boolean]
[:valid-thru {:optional true} ms/NonBlankString]]) ; ISO 8601 timestamp | |
(defn- fetch-token-and-parse-body
[token base-url]
(some-> (token-status-url token base-url)
(http/get {:query-params {:users (cached-active-users-count)
:site-uuid (setting/get :site-uuid-for-premium-features-token-checks)
:mb-version (:tag config/mb-version-info)}})
:body
(json/parse-string keyword))) | |
(mu/defn ^:private fetch-token-status* :- TokenStatus
"Fetch info about the validity of `token` from the MetaStore."
[token :- :string]
;; attempt to query the metastore API about the status of this token. If the request doesn't complete in a
;; reasonable amount of time throw a timeout exception
(log/infof "Checking with the MetaStore to see whether token '%s' is valid..." (u.str/mask token))
(if-not (mc/validate ValidToken token)
(do
(log/error (u/format-color 'red "Invalid token format!"))
{:valid false
:status "invalid"
:error-details (trs "Token should be 64 hexadecimal characters.")})
(let [fut (future
(try (fetch-token-and-parse-body token token-check-url)
(catch Exception e1
(log/error e1 (trs "Error fetching token status from {0}:" token-check-url))
;; Try the fallback URL, which was the default URL prior to 45.2
(try (fetch-token-and-parse-body token store-url)
;; if there was an error fetching the token from both the normal and fallback URLs, log the
;; first error and return a generic message about the token being invalid. This message
;; will get displayed in the Settings page in the admin panel so we do not want something
;; complicated
(catch Exception e2
(log/error e2 (trs "Error fetching token status from {0}:" store-url))
(let [body (u/ignore-exceptions (some-> (ex-data e1) :body (json/parse-string keyword)))]
(or
body
{:valid false
:status (tru "Unable to validate token")
:error-details (.getMessage e1)})))))))
result (deref fut fetch-token-status-timeout-ms ::timed-out)]
(if (= result ::timed-out)
(do
(future-cancel fut)
{:valid false
:status (tru "Unable to validate token")
:error-details (tru "Token validation timed out.")})
result)))) | |
TTL-memoized version of | (def ^{:arglists '([token])} fetch-token-status
;; don't blast the token status check API with requests if this gets called a bunch of times all at once -- wait for
;; the first request to finish
(let [lock (Object.)
f (memoize/ttl
(fn [token]
;; this is a sanity check to make sure we can actually get the active user count BEFORE we try to call
;; [[fetch-token-status*]], because `fetch-token-status*` catches Exceptions and therefore caches failed
;; results. We were running into issues in the e2e tests where `active-users-count` was timing out
;; because of to weird timeouts after restoring the app DB from a snapshot, which would cause other
;; tests to fail because a timed-out token check would get cached as a result.
(assert ((requiring-resolve 'metabase.db/db-is-set-up?)) "Metabase DB is not yet set up")
(u/with-timeout (u/seconds->ms 5)
(cached-active-users-count))
(fetch-token-status* token))
:ttl/threshold (u/minutes->ms 5))]
(fn [token]
(locking lock
(f token))))) |
(mu/defn ^:private valid-token->features* :- [:set ms/NonBlankString]
[token :- ValidToken]
(let [{:keys [valid status features error-details]} (fetch-token-status token)]
;; if token isn't valid throw an Exception with the `:status` message
(when-not valid
(throw (ex-info status
{:status-code 400, :error-details error-details})))
;; otherwise return the features this token supports
(set features))) | |
Amount of time to cache the status of a valid embedding token before forcing a re-check | (def ^:private ^:const valid-token-recheck-interval-ms (u/hours->ms 24)) ; once a day |
Check whether | (def ^:private ^{:arglists '([token])} valid-token->features
;; this is just `valid-token->features*` with some light caching
(let [f (memoize/ttl valid-token->features* :ttl/threshold valid-token-recheck-interval-ms)]
(fn [token]
(assert ((requiring-resolve 'metabase.db/db-is-set-up?)) "Metabase DB is not yet set up")
(f token)))) |
(defsetting token-status (deferred-tru "Cached token status for premium features. This is to avoid an API request on the the first page load.") :visibility :admin :type :json :audit :never :setter :none :getter (fn [] (some-> (premium-embedding-token) (fetch-token-status)))) | |
+----------------------------------------------------------------------------------------------------------------+ | SETTING & RELATED FNS | +----------------------------------------------------------------------------------------------------------------+ | |
(defsetting premium-embedding-token ; TODO - rename this to premium-features-token?
(deferred-tru "Token for premium features. Go to the MetaStore to get yours!")
:audit :never
:setter
(fn [new-value]
;; validate the new value if we're not unsetting it
(try
(when (seq new-value)
(when-not (mc/validate ValidToken new-value)
(throw (ex-info (tru "Token format is invalid.")
{:status-code 400, :error-details "Token should be 64 hexadecimal characters."})))
(valid-token->features new-value)
(log/info (trs "Token is valid.")))
(setting/set-value-of-type! :string :premium-embedding-token new-value)
(catch Throwable e
(log/error e (trs "Error setting premium features token"))
(throw (ex-info (.getMessage e) (merge
{:message (.getMessage e), :status-code 400}
(ex-data e)))))))) ; merge in error-details if present | |
(let [cached-logger (memoize/ttl
^{::memoize/args-fn (fn [[token _e]] [token])}
(fn [_token e]
(log/error (trs "Error validating token") ":" (ex-message e))
(log/debug e (trs "Error validating token")))
;; log every five minutes
:ttl/threshold (* 1000 60 5))]
(mu/defn ^:dynamic *token-features* :- [:set ms/NonBlankString]
"Get the features associated with the system's premium features token."
[]
(try
(or (some-> (premium-embedding-token) valid-token->features)
#{})
(catch Throwable e
(cached-logger (premium-embedding-token) e)
#{})))) | |
True if we have a valid premium features token with ANY features. | (defn- has-any-features? [] (boolean (seq (*token-features*)))) |
Does this instance's premium token have (has-feature? :sandboxes) ; -> true (has-feature? :toucan-management) ; -> false | (defn has-feature? [feature] (contains? (*token-features*) (name feature))) |
Returns an error that can be used to throw when an enterprise feature check fails. | (defn ee-feature-error
[feature-name]
(ex-info (tru "{0} is a paid feature not currently available to your instance. Please upgrade to use it. Learn more at metabase.com/upgrade/"
feature-name)
{:status-code 402})) |
Check if an token with | (mu/defn assert-has-feature
[feature-flag :- keyword?
feature-name :- [:or string? mu/localized-string-schema]]
(when-not (has-feature? feature-flag)
(throw (ee-feature-error feature-name)))) |
Check if has at least one of feature in | (mu/defn assert-has-any-features
[feature-flag :- [:sequential keyword?]
feature-name :- [:or string? mu/localized-string-schema]]
(when-not (some has-feature? feature-flag)
(throw (ee-feature-error feature-name)))) |
(defn- default-premium-feature-getter [feature]
(fn []
(and config/ee-available?
(has-feature? feature)))) | |
Set of defined premium feature keywords. | (def premium-features
(atom #{})) |
Convenience for generating a [[metabase.models.setting/defsetting]] form for a premium token feature. (The Settings definitions for Premium token features all look more or less the same, so this prevents a lot of code duplication.) | (defmacro ^:private define-premium-feature
[setting-name docstring feature & {:as options}]
(let [options (merge {:type :boolean
:visibility :public
:setter :none
:audit :never
:getter `(default-premium-feature-getter ~(some-> feature name))}
options)]
`(do
(swap! premium-features conj ~feature)
(defsetting ~setting-name
~docstring
~@(mapcat identity options))))) |
Logo Removal and Full App Embedding. Should we hide the 'Powered by Metabase' attribution on the embedding pages?
| (define-premium-feature hide-embed-branding? :embedding :export? true ;; This specific feature DOES NOT require the EE code to be present in order for it to return truthy, unlike ;; everything else. :getter #(has-feature? :embedding)) |
Should we allow full whitelabel embedding (reskinning the entire interface?) | (define-premium-feature enable-whitelabeling? :whitelabel :export? true) |
Should we enable the Audit Logs interface in the Admin UI? | (define-premium-feature enable-audit-app? :audit-app) |
Should we enable restrict email domains for subscription recipients? | (define-premium-feature ^{:added "0.41.0"} enable-email-allow-list?
:email-allow-list) |
Should we enable granular controls for cache TTL at the database, dashboard, and card level? | (define-premium-feature ^{:added "0.41.0"} enable-cache-granular-controls?
:cache-granular-controls) |
Should we enable initialization on launch from a config file? | (define-premium-feature ^{:added "0.41.0"} enable-config-text-file?
:config-text-file) |
Should we enable data sandboxes (row-level permissions)? | (define-premium-feature enable-sandboxes? :sandboxes :export? true) |
Should we enable JWT-based authentication? | (define-premium-feature enable-sso-jwt? :sso-jwt) |
Should we enable SAML-based authentication? | (define-premium-feature enable-sso-saml? :sso-saml) |
Should we enable advanced configuration for LDAP authentication? | (define-premium-feature enable-sso-ldap? :sso-ldap) |
Should we enable advanced configuration for Google Sign-In authentication? | (define-premium-feature enable-sso-google? :sso-google) |
Should we enable any SSO-based authentication? | (defn enable-any-sso?
[]
(or (enable-sso-jwt?)
(enable-sso-saml?)
(enable-sso-ldap?)
(enable-sso-google?))) |
Should we enable configuring session timeouts? | (define-premium-feature enable-session-timeout-config? :session-timeout-config) |
Can we disable login by password? | (define-premium-feature can-disable-password-login? :disable-password-login) |
Should we enable filters for dashboard subscriptions? | (define-premium-feature ^{:added "0.41.0"} enable-dashboard-subscription-filters?
:dashboard-subscription-filters) |
Should we enable extra knobs around permissions (block access, and in the future, moderator roles, feature-level permissions, etc.)? | (define-premium-feature ^{:added "0.41.0"} enable-advanced-permissions?
:advanced-permissions) |
Should we enable verified content, like verified questions and models (and more in the future, like actions)? | (define-premium-feature ^{:added "0.41.0"} enable-content-verification?
:content-verification) |
Should we enable Official Collections? | (define-premium-feature ^{:added "0.41.0"} enable-official-collections?
:official-collections) |
Should we enable SQL snippet folders? | (define-premium-feature ^{:added "0.41.0"} enable-snippet-collections?
:snippet-collections) |
Enable the v2 SerDes functionality | (define-premium-feature ^{:added "0.45.0"} enable-serialization?
:serialization) |
Enable restrict email recipients? | (define-premium-feature ^{:added "0.47.0"} enable-email-restrict-recipients?
:email-restrict-recipients) |
Is the Metabase instance running in the cloud? | (defsetting is-hosted? :type :boolean :visibility :public :setter :none :audit :never :getter (fn [] (boolean ((*token-features*) "hosting"))) :doc false) |
Should we various other enhancements, e.g. NativeQuerySnippet collection permissions?
By checking whether DEPRECATED -- it should now be possible to use the new 0.41.0+ features for everything previously covered by 'enhancements'. | (define-premium-feature ^:deprecated enable-enhancements? :enhancements :getter #(and config/ee-available? (has-any-features?))) |
+----------------------------------------------------------------------------------------------------------------+ | Defenterprise Macro | +----------------------------------------------------------------------------------------------------------------+ | |
Is the current namespace an Enterprise Edition namespace? | (defn- in-ee? [] (str/starts-with? (ns-name *ns*) "metabase-enterprise")) |
A map from fully-qualified EE function names to maps which include their EE and OSS implementations, as well as any additional options. This information is used to dynamically dispatch a call to the right implementation, depending on the available feature flags.
| (defonce
registry
(atom {})) |
Adds new values to the | (defn register-mapping! [ee-fn-name values] (swap! registry update ee-fn-name merge values)) |
(defn- check-feature
[feature]
(or (= feature :none)
(has-feature? feature))) | |
Dynamically tries to require an enterprise namespace and determine the correct implementation to call, based on the availability of EE code and the necessary premium feature. Returns a fn which, when invoked, applies its args to one of the EE implementation, the OSS implementation, or the fallback function. | (defn dynamic-ee-oss-fn
[ee-ns ee-fn-name]
(fn [& args]
(u/ignore-exceptions (classloader/require ee-ns))
(let [{:keys [ee oss feature fallback]} (get @registry ee-fn-name)]
(cond
(and ee (check-feature feature))
(apply ee args)
(and ee (fn? fallback))
(apply fallback args)
:else
(apply oss args))))) |
Throws an exception if the required :feature option is not present. | (defn- validate-ee-args
[{feature :feature :as options}]
(when-not feature
(throw (ex-info (trs "The :feature option is required when using defenterprise in an EE namespace!")
{:options options})))) |
The exception to throw when the provided option is not included in the | (defn- oss-options-error
[option options]
(ex-info (trs "{0} option for defenterprise should not be set in an OSS namespace! Set it on the EE function instead." option)
{:options options})) |
Throws exceptions if EE options are provided, or if an EE namespace is not provided. | (defn validate-oss-args
[ee-ns {:keys [feature fallback] :as options}]
(when-not ee-ns
(throw (Exception. (str (trs "An EE namespace must be provided when using defenterprise in an OSS namespace!")
" "
(trs "Add it immediately before the argument list.")))))
(when feature (throw (oss-options-error :feature options)))
(when fallback (throw (oss-options-error :fallback options)))) |
The exception to throw when defenterprise is used without a docstring. | (defn- docstr-exception
[fn-name]
(Exception. (tru "Enterprise function {0}/{1} does not have a docstring. Go add one!" (ns-name *ns*) fn-name))) |
Impl macro for | (defmacro defenterprise-impl
[{:keys [fn-name docstr ee-ns fn-tail options schema? return-schema]}]
(when-not docstr (throw (docstr-exception fn-name)))
(let [oss-or-ee (if (in-ee?) :ee :oss)]
(case oss-or-ee
:ee (validate-ee-args options)
:oss (validate-oss-args '~ee-ns options))
`(let [ee-ns# '~(or ee-ns (ns-name *ns*))
ee-fn-name# (symbol (str ee-ns# "/" '~fn-name))
oss-or-ee-fn# ~(if schema?
`(mu/fn ~(symbol (str fn-name)) :- ~return-schema ~@fn-tail)
`(fn ~(symbol (str fn-name)) ~@fn-tail))]
(register-mapping! ee-fn-name# (merge ~options {~oss-or-ee oss-or-ee-fn#}))
(def
~(vary-meta fn-name assoc :arglists ''([& args]))
~docstr
(dynamic-ee-oss-fn ee-ns# ee-fn-name#))))) |
(defn- options-conformer
[conformed-options]
(into {} (map (comp (juxt :k :v) second) conformed-options))) | |
(s/def ::defenterprise-options
(s/&
(s/*
(s/alt
:feature (s/cat :k #{:feature} :v keyword?)
:fallback (s/cat :k #{:fallback} :v #(or (#{:oss} %) (symbol? %)))))
(s/conformer options-conformer))) | |
(s/def ::defenterprise-args
(s/cat :docstr (s/? string?)
:ee-ns (s/? symbol?)
:options (s/? ::defenterprise-options)
:fn-tail (s/* any?))) | |
(s/def ::defenterprise-schema-args
(s/cat :return-schema (s/? (s/cat :- #{:-}
:schema any?))
:defenterprise-args (s/? ::defenterprise-args))) | |
Defines a function that has separate implementations between the Metabase Community Edition (aka OSS) and Enterprise Edition (EE). When used in a OSS namespace, defines a function that should have a corresponding implementation in an EE namespace (using the same macro). The EE implementation will be used preferentially to the OSS implementation if it is available. The first argument after the function name should be a symbol of the namespace containing the EE implementation. The corresponding EE function must have the same name as the OSS function. When used in an EE namespace, the namespace of the corresponding OSS implementation does not need to be included -- it will be inferred automatically, as long as a corresponding [[defenterprise]] call exists in an OSS namespace. Two additional options can be defined, when using this macro in an EE namespace. These options should be defined immediately before the args list of the function: `:feature`A keyword representing a premium feature which must be present for the EE implementation to be used. Use `:fallback`The keyword | (defmacro defenterprise
[fn-name & defenterprise-args]
{:pre [(symbol? fn-name)]}
(let [parsed-args (s/conform ::defenterprise-args defenterprise-args)
_ (when (s/invalid? parsed-args)
(throw (ex-info "Failed to parse defenterprise args"
(s/explain-data ::defenterprise-args parsed-args))))
args (assoc parsed-args :fn-name fn-name)]
`(defenterprise-impl ~args))) |
A version of defenterprise which allows for schemas to be defined for the args and return value. Schema syntax is
the same as when using | (defmacro defenterprise-schema
[fn-name & defenterprise-args]
{:pre [(symbol? fn-name)]}
(let [parsed-args (s/conform ::defenterprise-schema-args defenterprise-args)
_ (when (s/invalid? parsed-args)
(throw (ex-info "Failed to parse defenterprise-schema args"
(s/explain-data ::defenterprise-schema-args parsed-args))))
args (-> (:defenterprise-args parsed-args)
(assoc :schema? true)
(assoc :return-schema (-> parsed-args :return-schema :schema))
(assoc :fn-name fn-name))]
`(defenterprise-impl ~args))) |
Returns a boolean if the current user uses sandboxing for any database. In OSS this is always false. Will throw an error if [[api/current-user-id]] is not bound. | (defenterprise sandboxed-user?
metabase-enterprise.sandbox.api.util
[]
(when-not api/*current-user-id*
;; If no *current-user-id* is bound we can't check for sandboxes, so we should throw in this case to avoid
;; returning `false` for users who should actually be sandboxes.
(throw (ex-info (str (tru "No current user found"))
{:status-code 403})))
;; oss doesn't have sandboxing. But we throw if no current-user-id so the behavior doesn't change when ee version
;; becomes available
false) |
Returns a boolean if the current user uses connection impersonation for any database. In OSS this is always false. Will throw an error if [[api/current-user-id]] is not bound. | (defenterprise impersonated-user?
metabase-enterprise.advanced-permissions.api.util
[]
(when-not api/*current-user-id*
;; If no *current-user-id* is bound we can't check for impersonations, so we should throw in this case to avoid
;; returning `false` for users who should actually be using impersonations.
(throw (ex-info (str (tru "No current user found"))
{:status-code 403})))
;; oss doesn't have connection impersonation. But we throw if no current-user-id so the behavior doesn't change when
;; ee version becomes available
false) |
Returns a boolean if the current user uses sandboxing or connection impersonation for any database. In OSS is always false. Will throw an error if [[api/current-user-id]] is not bound. | (defn sandboxed-or-impersonated-user?
[]
(or (sandboxed-user?)
(impersonated-user?))) |
Public API for sending Pulses. | (ns metabase.pulse (:require [clojure.string :as str] [metabase.api.common :as api] [metabase.email :as email] [metabase.email.messages :as messages] [metabase.events :as events] [metabase.integrations.slack :as slack] [metabase.models.dashboard :as dashboard :refer [Dashboard]] [metabase.models.dashboard-card :as dashboard-card] [metabase.models.database :refer [Database]] [metabase.models.interface :as mi] [metabase.models.pulse :as pulse :refer [Pulse]] [metabase.models.serialization :as serdes] [metabase.public-settings :as public-settings] [metabase.pulse.markdown :as markdown] [metabase.pulse.parameters :as pulse-params] [metabase.pulse.render :as render] [metabase.pulse.util :as pu] [metabase.query-processor :as qp] [metabase.query-processor.dashboard :as qp.dashboard] [metabase.query-processor.timezone :as qp.timezone] [metabase.server.middleware.session :as mw.session] [metabase.shared.parameters.parameters :as shared.params] [metabase.util :as u] [metabase.util.i18n :refer [trs tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.retry :as retry] [metabase.util.ui-logic :as ui-logic] [metabase.util.urls :as urls] [toucan2.core :as t2]) (:import (clojure.lang ExceptionInfo))) |
------------------------------------------------- PULSE SENDING -------------------------------------------------- | |
Check if the card is empty | (defn- is-card-empty?
[card]
(if-let [result (:result card)]
(or (zero? (-> result :row_count))
;; Many aggregations result in [[nil]] if there are no rows to aggregate after filters
(= [[nil]]
(-> result :data :rows)))
;; Text cards have no result; treat as empty
true)) |
For the specific case of Dashboard Subscriptions we should use | (defn- merge-default-values
[parameters]
(for [{default-value :default, :as parameter} parameters]
(merge
(when default-value
{:value default-value})
(dissoc parameter :default)))) |
Returns subscription result for a card. This function should be executed under pulse's creator permissions. | (defn- execute-dashboard-subscription-card
[dashboard dashcard card-or-id parameters]
(assert api/*current-user-id* "Makes sure you wrapped this with a `with-current-user`.")
(try
(let [card-id (u/the-id card-or-id)
card (t2/select-one :model/Card :id card-id)
result (qp.dashboard/run-query-for-dashcard-async
:dashboard-id (u/the-id dashboard)
:card-id card-id
:dashcard-id (u/the-id dashcard)
:context :pulse ; TODO - we should support for `:dashboard-subscription` and use that to differentiate the two
:export-format :api
:parameters parameters
:middleware {:process-viz-settings? true
:js-int-to-string? false}
:run (fn [query info]
(qp/process-query-and-save-with-max-results-constraints!
(assoc query :async? false)
info)))]
(when-not (and (get-in dashcard [:visualization_settings :card.hide_empty]) (is-card-empty? result))
{:card card
:dashcard dashcard
:result result
:type :card}))
(catch Throwable e
(log/warn e (trs "Error running query for Card {0}" card-or-id))))) |
Check if dashcard is a virtual with type There are currently 3 types of virtual card: "text", "action", "link". | (defn virtual-card-of-type?
[dashcard ttype]
(when (= ttype (get-in dashcard [:visualization_settings :virtual_card :display]))
dashcard)) |
(defn- link-card-entity->url
[{:keys [db_id id model] :as _entity}]
(case model
"card" (urls/card-url id)
"dataset" (urls/card-url id)
"collection" (urls/collection-url id)
"dashboard" (urls/dashboard-url id)
"database" (urls/database-url id)
"table" (urls/table-url db_id id))) | |
(defn- link-card->text-part
[{:keys [entity url] :as _link-card}]
(let [url-link-card? (some? url)]
{:text (str (format
"### [%s](%s)"
(if url-link-card? url (:name entity))
(if url-link-card? url (link-card-entity->url entity)))
(when-let [description (if url-link-card? nil (:description entity))]
(format "\n%s" description)))
:type :text})) | |
Convert a dashcard that is a link card to pulse part. This function should be executed under pulse's creator permissions. | (defn- dashcard-link-card->part
[dashcard]
(assert api/*current-user-id* "Makes sure you wrapped this with a `with-current-user`.")
(let [link-card (get-in dashcard [:visualization_settings :link])]
(cond
(some? (:url link-card))
(link-card->text-part link-card)
;; if link card link to an entity, update the setting because
;; the info in viz-settings might be out-of-date
(some? (:entity link-card))
(let [{:keys [model id]} (:entity link-card)
instance (t2/select-one
(serdes/link-card-model->toucan-model model)
(dashboard-card/link-card-info-query-for-model model id))]
(when (mi/can-read? instance)
(link-card->text-part (assoc link-card :entity instance))))))) |
(defn- escape-heading-markdown
[dashcard]
(if (= "heading" (get-in dashcard [:visualization_settings :virtual_card :display]))
(update-in dashcard [:visualization_settings :text] #(str "## " (shared.params/escape-chars % shared.params/escaped-chars-regex)))
dashcard)) | |
Given a dashcard returns its part based on its type. The result will follow the pulse's creator permissions. | (defn- dashcard->part
[dashcard pulse dashboard]
(assert api/*current-user-id* "Makes sure you wrapped this with a `with-current-user`.")
(cond
(:card_id dashcard)
(let [parameters (merge-default-values (pulse-params/parameters pulse dashboard))]
(execute-dashboard-subscription-card dashboard dashcard (:card_id dashcard) parameters))
;; actions
(virtual-card-of-type? dashcard "action")
nil
;; link cards
(virtual-card-of-type? dashcard "link")
(dashcard-link-card->part dashcard)
;; text cards have existed for a while and I'm not sure if all existing text cards
;; will have virtual_card.display = "text", so assume everything else is a text card
:else
(let [parameters (merge-default-values (pulse-params/parameters pulse dashboard))]
(-> dashcard
(pulse-params/process-virtual-dashcard parameters)
escape-heading-markdown
:visualization_settings
(assoc :type :text))))) |
(defn- dashcards->part
[dashcards pulse dashboard]
(let [ordered-dashcards (sort dashboard-card/dashcard-comparator dashcards)]
(doall (for [dashcard ordered-dashcards
:let [part (dashcard->part dashcard pulse dashboard)]
:when (some? part)]
part)))) | |
(defn- tab->part
[{:keys [name]}]
{:text name
:type :tab-title}) | |
Fetch all the dashcards in a dashboard for a Pulse, and execute non-text cards. The generated parts will follow the pulse's creator permissions. | (defn- execute-dashboard
[{:keys [skip_if_empty] pulse-creator-id :creator_id :as pulse} dashboard & {:as _options}]
(let [dashboard-id (u/the-id dashboard)]
(mw.session/with-current-user pulse-creator-id
(let [parts (if (dashboard/has-tabs? dashboard)
(let [tabs-with-cards (t2/hydrate (t2/select :model/DashboardTab :dashboard_id dashboard-id) :tab-cards)]
(doall (flatten (for [{:keys [cards] :as tab} tabs-with-cards]
(concat [(tab->part tab)] (dashcards->part cards pulse dashboard))))))
(dashcards->part (t2/select :model/DashboardCard :dashboard_id dashboard-id) pulse dashboard))]
(if skip_if_empty
;; Remove any component of the parts that have no results when empty results aren't wanted
(remove (fn [part] (zero? (get-in part [:result :row_count] 0))) parts)
parts))))) |
(defn- database-id [card]
(or (:database_id card)
(get-in card [:dataset_query :database]))) | |
(mu/defn defaulted-timezone :- :string
"Returns the timezone ID for the given `card`. Either the report timezone (if applicable) or the JVM timezone."
[card :- (mi/InstanceOf :model/Card)]
(or (some->> card database-id (t2/select-one Database :id) qp.timezone/results-timezone-id)
(qp.timezone/system-timezone-id))) | |
(defn- first-question-name [pulse] (-> pulse :cards first :name)) | |
(defn- alert-condition-type->description [condition-type]
(case (keyword condition-type)
:meets (trs "reached its goal")
:below (trs "gone below its goal")
:rows (trs "results"))) | |
(def ^:private block-text-length-limit 3000) (def ^:private attachment-text-length-limit 2000) | |
If a mrkdwn string is greater than Slack's length limit, truncates it to fit the limit and adds an ellipsis character to the end. | (defn- truncate-mrkdwn
[mrkdwn limit]
(if (> (count mrkdwn) limit)
(-> mrkdwn
(subs 0 (dec limit))
(str "…"))
mrkdwn)) |
(defn- text->markdown-block
[text]
(let [mrkdwn (markdown/process-markdown text :slack)]
(when (not (str/blank? mrkdwn))
{:blocks [{:type "section"
:text {:type "mrkdwn"
:text (truncate-mrkdwn mrkdwn block-text-length-limit)}}]}))) | |
(defn- part->attachment-data
[part channel-id]
(case (:type part)
:card
(let [{:keys [card dashcard result]} part
{card-id :id card-name :name :as card} card]
{:title (or (-> dashcard :visualization_settings :card.title)
card-name)
:rendered-info (render/render-pulse-card :inline (defaulted-timezone card) card dashcard result)
:title_link (urls/card-url card-id)
:attachment-name "image.png"
:channel-id channel-id
:fallback card-name})
:text
(text->markdown-block (:text part))
:tab-title
(text->markdown-block (format "# %s" (:text part))))) | |
Returns a seq of slack attachment data structures, used in | (defn- create-slack-attachment-data
[parts]
(let [channel-id (slack/files-channel)]
(for [part parts
:let [attachment (part->attachment-data part channel-id)]
:when attachment]
attachment))) |
(defn- subject
[{:keys [name cards dashboard_id]}]
(if (or dashboard_id
(some :dashboard_id cards))
name
(trs "Pulse: {0}" name))) | |
(defn- filter-text [filter] (truncate-mrkdwn (format "*%s*\n%s" (:name filter) (pulse-params/value-string filter)) attachment-text-length-limit)) | |
Returns a block element that includes a dashboard's name, creator, and filters, for inclusion in a Slack dashboard subscription | (defn- slack-dashboard-header
[pulse dashboard]
(let [header-section {:type "header"
:text {:type "plain_text"
:text (subject pulse)
:emoji true}}
creator-section {:type "section"
:fields [{:type "mrkdwn"
:text (str "Sent by " (-> pulse :creator :common_name))}]}
filters (pulse-params/parameters pulse dashboard)
filter-fields (for [filter filters]
{:type "mrkdwn"
:text (filter-text filter)})
filter-section (when (seq filter-fields)
{:type "section"
:fields filter-fields})]
(if filter-section
{:blocks [header-section filter-section creator-section]}
{:blocks [header-section creator-section]}))) |
Returns a block element with the footer text and link which should be at the end of a Slack dashboard subscription. | (defn- slack-dashboard-footer
[pulse dashboard]
{:blocks
[{:type "divider"}
{:type "context"
:elements [{:type "mrkdwn"
:text (str "<" (pulse-params/dashboard-url (u/the-id dashboard) (pulse-params/parameters pulse dashboard)) "|"
"*Sent from " (public-settings/site-name) "*>")}]}]}) |
Maximum width of the rendered PNG of HTML to be sent to Slack. Content that exceeds this width (e.g. a table with many columns) is truncated. | (def slack-width 1200) |
Create an attachment in Slack for a given Card by rendering its content into an image and uploading it. Slack-attachment-uploader is a function which takes image-bytes and an attachment name, uploads the file, and returns an image url, defaulting to slack/upload-file!. Nested | (defn create-and-upload-slack-attachments!
([attachments] (create-and-upload-slack-attachments! attachments slack/upload-file!))
([attachments slack-attachment-uploader]
(letfn [(f [a] (select-keys a [:title :title_link :fallback]))]
(reduce (fn [processed {:keys [rendered-info attachment-name channel-id] :as attachment-data}]
(conj processed (if (:blocks attachment-data)
attachment-data
(if (:render/text rendered-info)
(-> (f attachment-data)
(assoc :text (:render/text rendered-info)))
(let [image-bytes (render/png-from-render-info rendered-info slack-width)
image-url (slack-attachment-uploader image-bytes attachment-name channel-id)]
(-> (f attachment-data)
(assoc :image_url image-url)))))))
[]
attachments)))) |
Do none of the cards have any results? | (defn- are-all-parts-empty? [results] (every? is-card-empty? results)) |
(defn- goal-met? [{:keys [alert_above_goal], :as pulse} [first-result]]
(let [goal-comparison (if alert_above_goal >= <)
goal-val (ui-logic/find-goal-value first-result)
comparison-col-rowfn (ui-logic/make-goal-comparison-rowfn (:card first-result)
(get-in first-result [:result :data]))]
(when-not (and goal-val comparison-col-rowfn)
(throw (ex-info (tru "Unable to compare results to goal for alert.")
{:pulse pulse
:result first-result})))
(boolean
(some (fn [row]
(goal-comparison (comparison-col-rowfn row) goal-val))
(get-in first-result [:result :data :rows]))))) | |
+----------------------------------------------------------------------------------------------------------------+ | Creating Notifications To Send | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- alert-or-pulse [pulse]
(if (:alert_condition pulse)
:alert
:pulse)) | |
Returns true if given the pulse type and resultset a new notification (pulse or alert) should be sent | (defmulti ^:private should-send-notification? (fn [pulse _parts] (alert-or-pulse pulse))) |
(defmethod should-send-notification? :alert
[{:keys [alert_condition] :as alert} parts]
(cond
(= "rows" alert_condition)
(not (are-all-parts-empty? parts))
(= "goal" alert_condition)
(goal-met? alert parts)
:else
(let [^String error-text (tru "Unrecognized alert with condition ''{0}''" alert_condition)]
(throw (IllegalArgumentException. error-text))))) | |
(defmethod should-send-notification? :pulse
[pulse parts]
(if (:skip_if_empty pulse)
(not (are-all-parts-empty? parts))
true)) | |
(defn- parts->cards-count
[parts]
(count (filter #(some? (#{:text :card} (:type %))) parts))) | |
Polymorphic function for creating notifications. This logic is different for pulse type (i.e. alert vs. pulse) and channel_type (i.e. email vs. slack) 'notification' used below means a map that has information needed to send a Pulse/Alert, including results of running the underlying query | (defmulti ^:private notification
{:arglists '([alert-or-pulse parts channel])}
(fn [pulse _ {:keys [channel_type]}]
[(alert-or-pulse pulse) (keyword channel_type)])) |
(defn- construct-pulse-email [subject recipients message]
{:subject subject
:recipients recipients
:message-type :attachments
:message message}) | |
(defmethod notification [:pulse :email]
[{pulse-id :id, pulse-name :name, dashboard-id :dashboard_id, :as pulse} parts {:keys [recipients]}]
(log/debug (u/format-color 'cyan (trs "Sending Pulse ({0}: {1}) with {2} Cards via email"
pulse-id (pr-str pulse-name) (parts->cards-count parts))))
(let [user-recipients (filter (fn [recipient] (and (u/email? (:email recipient))
(some? (:id recipient)))) recipients)
non-user-recipients (filter (fn [recipient] (and (u/email? (:email recipient))
(nil? (:id recipient)))) recipients)
timezone (->> parts (some :card) defaulted-timezone)
dashboard (update (t2/select-one Dashboard :id dashboard-id) :description markdown/process-markdown :html)
email-to-users (when (> (count user-recipients) 0)
(construct-pulse-email (subject pulse) (mapv :email user-recipients) (messages/render-pulse-email timezone pulse dashboard parts nil)))
email-to-nonusers (for [non-user (map :email non-user-recipients)]
(construct-pulse-email (subject pulse) [non-user] (messages/render-pulse-email timezone pulse dashboard parts non-user)))]
(if email-to-users
(conj email-to-nonusers email-to-users)
email-to-nonusers))) | |
(defmethod notification [:pulse :slack]
[{pulse-id :id, pulse-name :name, dashboard-id :dashboard_id, :as pulse}
parts
{{channel-id :channel} :details}]
(log/debug (u/format-color 'cyan (trs "Sending Pulse ({0}: {1}) with {2} Cards via Slack"
pulse-id (pr-str pulse-name) (parts->cards-count parts))))
(let [dashboard (t2/select-one Dashboard :id dashboard-id)]
{:channel-id channel-id
:attachments (remove nil?
(flatten [(slack-dashboard-header pulse dashboard)
(create-slack-attachment-data parts)
(when dashboard (slack-dashboard-footer pulse dashboard))]))})) | |
(defmethod notification [:alert :email]
[{:keys [id] :as pulse} parts channel]
(log/debug (trs "Sending Alert ({0}: {1}) via email" id name))
(let [condition-kwd (messages/pulse->alert-condition-kwd pulse)
email-subject (trs "Alert: {0} has {1}"
(first-question-name pulse)
(alert-condition-type->description condition-kwd))
user-recipients (filter (fn [recipient] (and (u/email? (:email recipient))
(some? (:id recipient)))) (:recipients channel))
non-user-recipients (filter (fn [recipient] (and (u/email? (:email recipient))
(nil? (:id recipient)))) (:recipients channel))
first-part (some :card parts)
timezone (defaulted-timezone first-part)
email-to-users (when (> (count user-recipients) 0)
(construct-pulse-email email-subject (mapv :email user-recipients) (messages/render-alert-email timezone pulse channel parts (ui-logic/find-goal-value first-part) nil)))
email-to-nonusers (for [non-user (map :email non-user-recipients)]
(construct-pulse-email email-subject [non-user] (messages/render-alert-email timezone pulse channel parts (ui-logic/find-goal-value first-part) non-user)))]
(if email-to-users
(conj email-to-nonusers email-to-users)
email-to-nonusers))) | |
(defmethod notification [:alert :slack]
[pulse parts {{channel-id :channel} :details}]
(log/debug (u/format-color 'cyan (trs "Sending Alert ({0}: {1}) via Slack" (:id pulse) (:name pulse))))
{:channel-id channel-id
:attachments (cons {:blocks [{:type "header"
:text {:type "plain_text"
:text (str "🔔 " (first-question-name pulse))
:emoji true}}]}
(create-slack-attachment-data parts))}) | |
(defmethod notification :default
[_ _ {:keys [channel_type]}]
(throw (UnsupportedOperationException. (tru "Unrecognized channel type {0}" (pr-str channel_type))))) | |
(defn- parts->notifications [{:keys [channels channel-ids] pulse-id :id :as pulse} parts]
(let [channel-ids (or channel-ids (mapv :id channels))]
(when (should-send-notification? pulse parts)
(let [event-type (if (= :pulse (alert-or-pulse pulse))
:event/subscription-send
:event/alert-send)]
(events/publish-event! event-type {:id (:id pulse)
:user-id (:creator_id pulse)
:object {:recipients (map :recipients (:channels pulse))
:filters (:parameters pulse)}}))
(when (:alert_first_only pulse)
(t2/delete! Pulse :id pulse-id))
;; `channel-ids` is the set of channels to send to now, so only send to those. Note the whole set of channels
(for [channel channels
:when (contains? (set channel-ids) (:id channel))]
(notification pulse parts channel))))) | |
Execute the underlying queries for a sequence of Pulses and return the parts as 'notification' maps. | (defn- pulse->notifications
[{:keys [cards] pulse-id :id :as pulse} dashboard]
(parts->notifications
pulse
(if dashboard
;; send the dashboard
(execute-dashboard pulse dashboard)
;; send the cards instead
(for [card cards
;; Pulse ID may be `nil` if the Pulse isn't saved yet
:let [part (assoc (pu/execute-card pulse (u/the-id card) :pulse-id pulse-id) :type :card)]
;; some cards may return empty part, e.g. if the card has been archived
:when part]
part)))) |
+----------------------------------------------------------------------------------------------------------------+ | Sending Notifications | +----------------------------------------------------------------------------------------------------------------+ | |
Invokes the side-effecty function for sending emails/slacks depending on the notification type | (defmulti ^:private send-notification!
{:arglists '([pulse-or-alert])}
(fn [{:keys [channel-id]}]
(if channel-id :slack :email))) |
(defmethod send-notification! :slack
[{:keys [channel-id message attachments]}]
(let [attachments (create-and-upload-slack-attachments! attachments)]
(try
(slack/post-chat-message! channel-id message attachments)
(catch ExceptionInfo e
;; Token errors have already been logged and we should not retry.
(when-not (contains? (:errors (ex-data e)) :slack-token)
(throw e)))))) | |
(defmethod send-notification! :email
[emails]
(doseq [{:keys [subject recipients message-type message]} emails]
(email/send-message-or-throw! {:subject subject
:recipients recipients
:message-type message-type
:message message
:bcc? (email/bcc-enabled?)}))) | |
Like [[send-notification!]] but retries sending on errors according to the retry settings. | (defn- send-notification-retrying! [& args] (apply (retry/decorate send-notification!) args)) |
(defn- send-notifications! [notifications]
(doseq [notification notifications]
;; do a try-catch around each notification so if one fails, we'll still send the other ones for example, an Alert
;; set up to send over both Slack & email: if Slack fails, we still want to send the email (#7409)
(try
(send-notification-retrying! notification)
(catch Throwable e
(log/error e (trs "Error sending notification!")))))) | |
Execute and Send a
Example: (send-pulse! pulse) Send to all Channels (send-pulse! pulse :channel-ids [312]) Send only to Channel with :id = 312 | (defn send-pulse!
[{:keys [dashboard_id], :as pulse} & {:keys [channel-ids]}]
{:pre [(map? pulse) (integer? (:creator_id pulse))]}
(let [dashboard (t2/select-one Dashboard :id dashboard_id)
pulse (-> (mi/instance Pulse pulse)
;; This is usually already done by this step, in the `send-pulses` task which uses `retrieve-pulse`
;; to fetch the Pulse.
pulse/hydrate-notification
(merge (when channel-ids {:channel-ids channel-ids})))]
(when (not (:archived dashboard))
(send-notifications! (pulse->notifications pulse dashboard))))) |
(ns metabase.pulse.markdown
(:require
[clojure.edn :as edn]
[clojure.java.io :as io]
[clojure.string :as str]
[clojure.walk :as walk]
[metabase.public-settings :as public-settings]
[metabase.util :as u])
(:import
(com.vladsch.flexmark.ast AutoLink BlockQuote BulletList BulletListItem Code Emphasis FencedCodeBlock HardLineBreak
Heading HtmlBlock HtmlCommentBlock HtmlEntity HtmlInline HtmlInlineBase HtmlInlineComment
HtmlInnerBlockComment Image ImageRef IndentedCodeBlock Link LinkRef MailLink OrderedList
OrderedListItem Paragraph Reference SoftLineBreak StrongEmphasis Text ThematicBreak)
(com.vladsch.flexmark.ext.autolink AutolinkExtension)
(com.vladsch.flexmark.html HtmlRenderer LinkResolver LinkResolverFactory)
(com.vladsch.flexmark.html.renderer LinkResolverBasicContext LinkStatus)
(com.vladsch.flexmark.parser Parser)
(com.vladsch.flexmark.util.ast Document Node)
(com.vladsch.flexmark.util.data MutableDataSet)
(java.net URI))) | |
(set! *warn-on-reflection* true) | |
+----------------------------------------------------------------------------------------------------------------+ | Markdown parsing | +----------------------------------------------------------------------------------------------------------------+ | |
An instance of a Flexmark parser | (def ^:private parser
(let [options (.. (MutableDataSet.)
(set Parser/EXTENSIONS [(AutolinkExtension/create)]))]
(.build (Parser/builder options)))) |
Mappings from Flexmark AST nodes to keyword tags | (def ^:private node-to-tag-mapping
{Document :document
Paragraph :paragraph
ThematicBreak :horizontal-line
HardLineBreak :hard-line-break
SoftLineBreak :soft-line-break
Heading :heading
StrongEmphasis :bold
Emphasis :italic
OrderedList :ordered-list
BulletList :unordered-list
OrderedListItem :list-item
BulletListItem :list-item
Code :code
FencedCodeBlock :codeblock
IndentedCodeBlock :codeblock
BlockQuote :blockquote
Link :link
Reference :reference
LinkRef :link-ref
ImageRef :image-ref
Image :image
AutoLink :auto-link
MailLink :mail-link
HtmlEntity :html-entity
HtmlBlock :html-block
HtmlInline :html-inline
HtmlCommentBlock :html-comment-block
HtmlInlineBase :html-inline-base
HtmlInlineComment :html-inline-comment
HtmlInnerBlockComment :html-inner-block-comment}) |
(defn- node-to-tag [node] (node-to-tag-mapping (type node))) | |
(defprotocol ^:private ASTNode (to-clojure [this])) | |
(defn- convert-children [node] (map to-clojure (.getChildren ^Node node))) | |
(extend-protocol ASTNode
Node
(to-clojure [this]
{:tag (node-to-tag this)
:attrs {}
:content (convert-children this)})
Text
(to-clojure [this]
(str (.getChars this)))
FencedCodeBlock
(to-clojure [this]
{:tag (node-to-tag this)
:attrs {}
:content (str (.getContentChars this))})
IndentedCodeBlock
(to-clojure [this]
{:tag (node-to-tag this)
:attrs {}
:content (str (.getContentChars this))})
Link
(to-clojure [this]
{:tag (node-to-tag this)
:attrs {:href (str (.getUrl this))
:title (not-empty (str (.getTitle this)))}
:content (convert-children this)})
Reference
(to-clojure [this]
{:tag (node-to-tag this)
:attrs {:title (not-empty (str (.getTitle this)))
:label (str (.getReference this))
:url (str (.getUrl this))}})
LinkRef
(to-clojure [this]
{:tag (node-to-tag this)
:attrs {:reference (-> (.getDocument this)
(.get Parser/REFERENCES)
(get (u/lower-case-en (str (.getReference this))))
to-clojure)}
:content (convert-children this)})
ImageRef
(to-clojure [this]
{:tag (node-to-tag this)
:attrs {:reference (-> (.getDocument this)
(.get Parser/REFERENCES)
(get (u/lower-case-en (str (.getReference this))))
to-clojure)}
:content (convert-children this)})
Image
(to-clojure [this]
{:tag (node-to-tag this)
:attrs {:src (str (.getUrl this))
:alt (str (.getText this))
:title (not-empty (str (.getTitle this)))}})
AutoLink
(to-clojure [this]
{:tag (node-to-tag this)
:attrs {:href (str (.getUrl this))}})
MailLink
(to-clojure [this]
{:tag (node-to-tag this)
:attrs {:address (str (.getText this))}})
HtmlEntity
(to-clojure [this]
{:tag (node-to-tag this)
:content (str (.getChars this))})
HtmlBlock
(to-clojure [this]
(str (.getChars this)))
HtmlInline
(to-clojure [this]
(str (.getChars this)))
HtmlCommentBlock
(to-clojure [this]
(str (.getChars this)))
HtmlInlineComment
(to-clojure [this]
(str (.getChars this)))
nil
(to-clojure [_this]
nil)) | |
+----------------------------------------------------------------------------------------------------------------+ | Slack markup generation | +----------------------------------------------------------------------------------------------------------------+ | |
(def ^:private html-entities (delay (edn/read-string (slurp (io/resource "html-entities.edn"))))) | |
(def ^:private escaped-chars-regex
#"\\[\\/*_`'\[\](){}<>#+-.!$@%^&=|\?~]") | |
Insert zero-width characters before and after certain characters that are escaped in the Markdown (or are otherwise parsed as plain text) to prevent them from being parsed as formatting in Slack. | (defn- escape-text
[string]
(-> string
;; First, remove backslashes from escaped formatting characters since they're not removed during Markdown parsing
(str/replace escaped-chars-regex #(str (second %1)))
;; Add a soft hyphen around certain chars to avoid triggering formatting in Slack
(str/replace "&" "\u00ad&\u00ad")
(str/replace ">" "\u00ad>\u00ad")
(str/replace "<" "\u00ad<\u00ad")
(str/replace "*" "\u00ad*\u00ad")
(str/replace "_" "\u00ad_\u00ad")
(str/replace "`" "\u00ad`\u00ad")
(str/replace "~" "\u00ad~\u00ad"))) |
If the provided URI is a relative path, resolve it relative to the site URL so that links work correctly in Slack/Email. | (defn- resolve-uri
[^String uri]
(letfn [(ensure-slash [s] (when s
(cond-> s
(not (str/ends-with? s "/")) (str "/"))))]
(when uri
(if-let [^String site-url (ensure-slash (public-settings/site-url))]
(.. (URI. site-url) (resolve uri) toString)
uri)))) |
Given the value from the :content field of a Markdown AST node, and a keyword representing a tag type, converts all
instances of the tag in the content to | (defn- ^:private strip-tag
[content tag]
(walk/postwalk
(fn [node]
(if (and (map? node) (= (:tag node) tag))
(assoc node :tag :default)
node))
content)) |
Takes an AST representing Markdown input, and converts it to a string that will render nicely in Slack. Some of the differences to Markdown include:
* All headers are just rendered as bold text.
* Ordered and unordered lists are printed in plain text.
* Inline images are rendered as text that links to the image source, e.g. | (defmulti ast->slack :tag) |
Given the value from the :content field of a Markdown AST node, recursively resolves subnodes into a nested list of strings. | (defn ^:private resolved-content
[content]
(if (string? content)
(escape-text content)
(map #(if (string? %)
(escape-text %)
(ast->slack %))
content))) |
Given the resolved content of a Markdown AST node, converts it into a single flattened string. This is used for rendering a couple specific types of nodes, such as list items. | (defn ^:private resolved-content-string
[resolved-content]
(-> resolved-content
flatten
str/join)) |
Given the value from the :content field of a Markdown AST node, recursively resolves it and returns a list of strings corresponding to individual lines in the result. | (defn ^:private resolved-lines
[content]
(-> content
resolved-content
resolved-content-string
str/split-lines)) |
(defmethod ast->slack :default
[{content :content}]
(resolved-content content)) | |
(defmethod ast->slack :document
[{content :content}]
(resolved-content content)) | |
(defmethod ast->slack :paragraph
[{content :content}]
[(resolved-content content) "\n"]) | |
(defmethod ast->slack :soft-line-break [_] " ") | |
(defmethod ast->slack :hard-line-break [_] "\n") | |
(defmethod ast->slack :horizontal-line [_] "\n───────────────────\n") | |
(defmethod ast->slack :heading
[{content :content}]
["*" (resolved-content content) "*\n"]) | |
(defmethod ast->slack :bold
[{content :content}]
["*" (resolved-content (strip-tag content :bold)) "*"]) | |
(defmethod ast->slack :italic
[{content :content}]
["_" (resolved-content (strip-tag content :italic)) "_"]) | |
(defmethod ast->slack :code
[{content :content}]
["`" (resolved-content content) "`"]) | |
(defmethod ast->slack :codeblock
[{content :content}]
["```\n" (resolved-content content) "```"]) | |
(defmethod ast->slack :blockquote
[{content :content}]
(let [lines (resolved-lines content)]
(interpose "\n" (map (fn [line] [">" line]) lines)))) | |
(defmethod ast->slack :link
[{:keys [content attrs]}]
(let [resolved-uri (resolve-uri (:href attrs))
resolved-content (resolved-content content)]
(if (contains? #{:image :image-ref} (:tag (first content)))
;; If this is a linked image, add link target on separate line after image placeholder
[resolved-content "\n(" resolved-uri ")"]
["<" resolved-uri "|" resolved-content ">"]))) | |
(defmethod ast->slack :link-ref
[{:keys [content attrs]}]
(let [resolved-uri (resolve-uri (-> attrs :reference :attrs :url))
resolved-content (resolved-content content)]
(if resolved-uri
["<" resolved-uri "|" resolved-content ">"]
;; If this was parsed as a link-ref but has no reference, assume it was just a pair of square brackets and
;; restore them. This is a known discrepency between flexmark-java and Markdown rendering on the frontend.
["[" resolved-content "]"]))) | |
(defmethod ast->slack :auto-link
[{{href :href} :attrs}]
["<" href ">"]) | |
(defmethod ast->slack :mail-link
[{{address :address} :attrs}]
["<mailto:" address "|" address ">"]) | |
(defmethod ast->slack :list-item
[{content :content}]
(let [resolved-content (resolved-content content)
;; list items might have nested lists or other elements, which should have their indentation level increased
indented-content (->> (rest resolved-content)
resolved-content-string
str/split-lines
(map #(str " " %))
(str/join "\n"))]
(if-not (str/blank? indented-content)
[(first resolved-content) indented-content "\n"]
resolved-content))) | |
(defmethod ast->slack :unordered-list
[{content :content}]
(map (fn [list-item] ["• " list-item])
(resolved-content content))) | |
(defmethod ast->slack :ordered-list
[{content :content}]
(map-indexed (fn [idx list-item] [(inc idx) ". " list-item])
(resolved-content content))) | |
(defmethod ast->slack :image
[{{:keys [src alt]} :attrs}]
;; Replace images with text that links to source, including alt text if available
(if (str/blank? alt)
["<" src "|[Image]>"]
["<" src "|[Image: " alt "]>"])) | |
(defmethod ast->slack :image-ref
[{:keys [content attrs]}]
(let [src (-> attrs :reference :attrs :url)
alt (-> content resolved-content resolved-content-string)]
(if (str/blank? alt)
["<" src "|[Image]>"]
["<" src "|[Image: " alt "]>"]))) | |
(defmethod ast->slack :html-entity
[{content :content}]
(some->> content
(get @html-entities)
(:characters))) | |
Returns true if this node was parsed as a link ref, but has no references. This probably means the original text was just a pair of square brackets, and not an actual link ref. This is a known discrepency between flexmark-java and Markdown rendering on the frontend. | (defn- empty-link-ref?
[^Node node]
(and (instance? LinkRef node)
(-> (.getDocument node)
(.get Parser/REFERENCES)
empty?))) |
An instance of a Flexmark HTML renderer | (def ^:private renderer
(let [options (.. (MutableDataSet.)
(set HtmlRenderer/ESCAPE_HTML true)
(toImmutable))
lr-factory (reify LinkResolverFactory
(^LinkResolver apply [_this ^LinkResolverBasicContext _context]
(reify LinkResolver
(resolveLink [_this node _context link]
(if-let [url (cond
(instance? MailLink node) (.getUrl link)
(empty-link-ref? node) nil
:else (resolve-uri (.getUrl link)))]
(.. link
(withStatus LinkStatus/VALID)
(withUrl url))
link)))))]
(.build (.linkResolverFactory (HtmlRenderer/builder options) lr-factory)))) |
Converts a markdown string from a virtual card into a form that can be sent to a channel (Slack's markup language, or HTML for email). | (defmulti process-markdown (fn [_markdown channel-type] channel-type)) |
(defmethod process-markdown :slack
[markdown _]
(-> (.parse ^Parser parser ^String markdown)
to-clojure
ast->slack
flatten
str/join
str/trim)) | |
(defmethod process-markdown :html
[markdown _]
(let [ast (.parse ^Parser parser ^String markdown)]
(.render ^HtmlRenderer renderer ^Document ast))) | |
Utilities for processing parameters for inclusion in dashboard subscriptions. | (ns metabase.pulse.parameters (:require [clojure.string :as str] [metabase.public-settings :as public-settings] [metabase.public-settings.premium-features :refer [defenterprise]] [metabase.shared.parameters.parameters :as shared.params] [metabase.util :as u] [metabase.util.urls :as urls] [ring.util.codec :as codec])) |
OSS way of getting filter parameters for a dashboard subscription | (defenterprise the-parameters metabase-enterprise.dashboard-subscription-filters.pulse [_pulse dashboard] (:parameters dashboard)) |
Returns the parameter value, such that: * nil value => nil * missing value key => default | (defn- param-val-or-default [parameter] (get parameter :value (:default parameter))) |
Returns the list of parameters applied to a dashboard subscription, filtering out ones without a value | (defn parameters [subscription dashboard] (filter param-val-or-default (the-parameters subscription dashboard))) |
Returns the value(s) of a dashboard filter, formatted appropriately. | (defn value-string
[parameter]
(let [tyype (:type parameter)
values (param-val-or-default parameter)]
(try (shared.params/formatted-value tyype values (public-settings/site-locale))
(catch Throwable _
(shared.params/formatted-list (u/one-or-many values)))))) |
Given a dashboard's ID and parameters, returns a URL for the dashboard with filters included | (defn dashboard-url
[dashboard-id parameters]
(let [base-url (urls/dashboard-url dashboard-id)
url-params (flatten
(for [param parameters]
(for [value (u/one-or-many (param-val-or-default param))]
(str (codec/url-encode (:slug param))
"="
(codec/url-encode value)))))]
(str base-url (when (seq url-params)
(str "?" (str/join "&" url-params)))))) |
Heading cards should not escape characters. | (defn- escape-markdown-chars? [dashcard] (not= "heading" (get-in dashcard [:visualization_settings :virtual_card :display]))) |
Given a dashcard and the parameters on a dashboard, returns the dashcard with any parameter values appropriately substituted into connected variables in the text. | (defn process-virtual-dashcard
[dashcard parameters]
(let [text (-> dashcard :visualization_settings :text)
parameter-mappings (:parameter_mappings dashcard)
tag-names (shared.params/tag_names text)
param-id->param (into {} (map (juxt :id identity) parameters))
tag-name->param-id (into {} (map (juxt (comp second :target) :parameter_id) parameter-mappings))
tag->param (reduce (fn [m tag-name]
(when-let [param-id (get tag-name->param-id tag-name)]
(assoc m tag-name (get param-id->param param-id))))
{}
tag-names)]
(update-in dashcard [:visualization_settings :text] shared.params/substitute_tags tag->param (public-settings/site-locale) (escape-markdown-chars? dashcard)))) |
Improve the feedback loop for Dashboard Subscription outputs. | (ns metabase.pulse.preview (:require [clojure.data.csv :as csv] [clojure.string :as str] [clojure.zip :as zip] [hiccup.core :as hiccup] [hickory.core :as hik] [hickory.render :as hik.r] [hickory.zip :as hik.z] [metabase.email.messages :as messages] [metabase.pulse :as pulse] [metabase.pulse.markdown :as markdown] [metabase.pulse.render :as render] [metabase.pulse.render.image-bundle :as img] [metabase.pulse.render.png :as png] [metabase.pulse.render.style :as style] [toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
(def ^:private table-style-map
{:border "1px solid black"
:border-collapse "collapse"
:padding "5px"}) | |
(def ^:private table-style (style/style table-style-map)) | |
(def ^:private csv-row-limit 10) | |
(defn- csv-to-html-table [csv-string]
(let [rows (csv/read-csv csv-string)]
[:table {:style table-style}
(for [row (take (inc csv-row-limit) rows)] ;; inc row-limit to include the header and the expected # of rows
[:tr {:style table-style}
(for [cell row]
[:td {:style table-style} cell])])])) | |
(def ^:private result-attachment #'messages/result-attachment) | |
(defn- render-csv-for-dashcard
[part]
(-> part
(assoc-in [:card :include_csv] true)
result-attachment
first
:content
slurp
csv-to-html-table)) | |
(defn- render-one-dashcard
[{:keys [card dashcard result] :as dashboard-result}]
(letfn [(cellfn [content]
[:td {:style (style/style (merge table-style-map {:max-width "400px"}))}
content])]
(if card
(let [base-render (render/render-pulse-card :inline (pulse/defaulted-timezone card) card dashcard result)
html-src (-> base-render :content)
img-src (-> base-render
(png/render-html-to-png 1200)
img/render-img-data-uri)
csv-src (render-csv-for-dashcard dashboard-result)]
[:tr
(cellfn (:name card))
(cellfn [:img {:style (style/style {:max-width "400px"}) :src img-src}])
(cellfn html-src)
(cellfn csv-src)])
[:tr
(cellfn nil)
(cellfn
[:div {:style (style/style {:font-family "Lato"
:font-size "13px" #_ "0.875em"
:font-weight "400"
:font-style "normal"
:color "#4c5773"
:-moz-osx-font-smoothing "grayscale"})}
(markdown/process-markdown (:text dashboard-result) :html)])
(cellfn nil)]))) | |
(def ^:private execute-dashboard #'pulse/execute-dashboard) | |
Given a dashboard ID, renders all of the dashcards to hiccup datastructure. | (defn render-dashboard-to-hiccup
[dashboard-id]
(let [user (t2/select-one :model/User)
dashboard (t2/select-one :model/Dashboard :id dashboard-id)
dashboard-results (execute-dashboard {:creator_id (:id user)} dashboard)
render (->> (map render-one-dashcard (map #(assoc % :dashboard-id dashboard-id) dashboard-results))
(into [[:tr
[:th {:style (style/style table-style-map)} "Card Name"]
[:th {:style (style/style table-style-map)} "PNG"]
[:th {:style (style/style table-style-map)} "HTML"]
[:th {:style (style/style table-style-map)} "CSV"]]])
(into [:table {:style (style/style table-style-map)}]))]
render)) |
Given a dashboard ID, renders all of the dashcards into an html document. | (defn render-dashboard-to-html [dashboard-id] (hiccup/html (render-dashboard-to-hiccup dashboard-id))) |
(defn- collect-inline-style
[style-lines {:keys [attrs] :as node}]
(let [{:keys [style]} attrs]
(if style
(let [{:keys [id] :or {id (str (gensym "inline"))}} attrs]
(swap! style-lines assoc id style)
(-> node
(update :attrs dissoc :style)
(update :attrs assoc :id id)))
node))) | |
(defn- css-str-fragment
[[id css-str]]
(format "#%s {%s}" id css-str)) | |
(defn- style-node
[style-lines-map]
{:type :element
:tag :style
:attrs {:nonce "%NONCE%"}
:content [(str/join "\n" (map css-str-fragment style-lines-map))]}) | |
(defn- move-inline-styles
[hickory-tree]
(let [zipper (hik.z/hickory-zip hickory-tree)
style-lines (atom {})
xf-tree (loop [loc zipper]
(if (zip/end? loc)
(zip/root loc)
(recur (zip/next (zip/edit loc (partial collect-inline-style style-lines))))))]
(update xf-tree :content
(fn [v]
(vec (conj (seq v) (style-node @style-lines))))))) | |
Collects styles defined on element 'style' attributes and adds them to a single inline style tag. Each element that does not already have an 'id' attribute will have one generated, and the style will be added under that id, or the element's existing id. For example, the html string " This is red text. " Will result in a CSS map-entry that looks like: #inline12345 {color: red;}.This approach will capture all inline styles but is naive and will result in lots of style duplications. Since this is a simple preview endpoint not meant for heavy use outside of manual checks, this slower approach seems ok for now (as of 2023-12-18). | (defn style-tag-from-inline-styles
[html-str]
(-> html-str
hik/parse
hik/as-hickory
move-inline-styles
hik.r/hickory-to-html)) |
(defn- add-style-nonce [request response]
(update response :body (fn [html-str]
(str/replace html-str #"%NONCE%" (:nonce request))))) | |
Constructs a middleware handler function that adds the generated nonce to an html string.
This is only designed to be used with an endpoint that returns an html string response containing
a style tag with an attribute 'nonce=%NONCE%'. Specifcally, this was designed to be used with the
endpoint | (defn style-tag-nonce-middleware
[only-this-uri handler]
(fn [request respond raise]
(let [{:keys [uri]} request]
(handler
request
(if (str/starts-with? uri only-this-uri)
(comp respond (partial add-style-nonce request))
respond)
raise)))) |
(ns metabase.pulse.render (:require [hiccup.core :refer [h]] [metabase.formatter :as formatter] [metabase.models.dashboard-card :as dashboard-card] [metabase.pulse.markdown :as markdown] [metabase.pulse.render.body :as body] [metabase.pulse.render.image-bundle :as image-bundle] [metabase.pulse.render.png :as png] [metabase.pulse.render.style :as style] [metabase.shared.models.visualization-settings :as mb.viz] [metabase.util.i18n :refer [trs tru]] [metabase.util.log :as log] [metabase.util.urls :as urls] [schema.core :as s])) | |
Should the rendered pulse include buttons? (default: | (def ^:dynamic *include-buttons* false) |
Should the rendered pulse include a title? (default: | (def ^:dynamic *include-title* false) |
Should the rendered pulse include a card description? (default: | (def ^:dynamic *include-description* false) |
(defn- card-href [card] (h (urls/card-url (:id card)))) | |
(s/defn ^:private make-title-if-needed :- (s/maybe formatter/RenderedPulseCard)
[render-type card dashcard]
(when *include-title*
(let [card-name (or (-> dashcard :visualization_settings :card.title)
(-> card :name))
image-bundle (when *include-buttons*
(image-bundle/external-link-image-bundle render-type))]
{:attachments (when image-bundle
(image-bundle/image-bundle->attachment image-bundle))
:content [:table {:style (style/style {:margin-bottom :2px
:border-collapse :collapse
:width :100%})}
[:tbody
[:tr
[:td {:style (style/style {:padding :0
:margin :0})}
[:a {:style (style/style (style/header-style))
:href (card-href card)
:target "_blank"
:rel "noopener noreferrer"}
(h card-name)]]
[:td {:style (style/style {:text-align :right})}
(when *include-buttons*
[:img {:style (style/style {:width :16px})
:width 16
:src (:image-src image-bundle)}])]]]]}))) | |
(s/defn ^:private make-description-if-needed :- (s/maybe formatter/RenderedPulseCard)
[dashcard card]
(when *include-description*
(when-let [description (or (get-in dashcard [:visualization_settings :card.description])
(:description card))]
{:attachments {}
:content [:div {:style (style/style {:color style/color-text-medium
:font-size :12px
:margin-bottom :8px})}
(markdown/process-markdown description :html)]}))) | |
Determine the pulse (visualization) type of a | (defn detect-pulse-chart-type
[{display-type :display, card-name :name, :as card} maybe-dashcard {:keys [cols rows], :as data}]
(let [col-sample-count (delay (count (take 3 cols)))
row-sample-count (delay (count (take 2 rows)))
[col-1-rowfn col-2-rowfn] (formatter/graphing-column-row-fns card data)
col-1 (delay (col-1-rowfn cols))
col-2 (delay (col-2-rowfn cols))]
(letfn [(chart-type [tyype reason & args]
(log/tracef "Detected chart type %s for Card %s because %s"
tyype (pr-str card-name) (apply format reason args))
tyype)
(col-description [{col-name :name, base-type :base_type}]
(format "%s (%s)" (pr-str col-name) base-type))]
(cond
(or (empty? rows)
;; Many aggregations result in [[nil]] if there are no rows to aggregate after filters
(= [[nil]] (-> data :rows)))
(chart-type :empty "there are no rows in results")
(#{:pin_map :state :country} display-type)
(chart-type nil "display-type is %s" display-type)
(and (some? maybe-dashcard)
(pos? (count (dashboard-card/dashcard->multi-cards maybe-dashcard)))
(not (#{:combo} display-type)))
(chart-type :multiple "result has multiple card semantics, a multiple chart")
;; for scalar/smartscalar, the display-type might actually be :line, so we can't have line above
(and (not (contains? #{:progress :gauge} display-type))
(= @col-sample-count @row-sample-count 1))
(chart-type :scalar "result has one row and one column")
(#{:scalar
:line
:area
:bar
:combo
:row
:funnel
:progress
:gauge
:table
:waterfall} display-type)
(chart-type display-type "display-type is %s" display-type)
(#{:smartscalar} display-type)
(chart-type :javascript_visualization "display-type is javascript_visualization")
(= display-type :pie)
(chart-type :categorical/donut "result has two cols (%s and %s (number))" (col-description @col-1) (col-description @col-2))
:else
(chart-type :table "no other chart types match"))))) |
(defn- is-attached? [card] ((some-fn :include_csv :include_xls) card)) | |
(s/defn ^:private render-pulse-card-body :- formatter/RenderedPulseCard
[render-type timezone-id :- (s/maybe s/Str) card dashcard {:keys [data error] :as results}]
(try
(when error
(throw (ex-info (tru "Card has errors: {0}" error) (assoc results :card-error true))))
(let [chart-type (or (detect-pulse-chart-type card dashcard data)
(when (is-attached? card)
:attached)
:unknown)]
(log/debug (trs "Rendering pulse card with chart-type {0} and render-type {1}" chart-type render-type))
(body/render chart-type render-type timezone-id card dashcard data))
(catch Throwable e
(if (:card-error (ex-data e))
(do
(log/error e (trs "Pulse card query error"))
(body/render :card-error nil nil nil nil nil))
(do
(log/error e (trs "Pulse card render error"))
(body/render :render-error nil nil nil nil nil)))))) | |
(s/defn render-pulse-card :- formatter/RenderedPulseCard
"Render a single `card` for a `Pulse` to Hiccup HTML. `result` is the QP results. Returns a map with keys
- attachments
- content (a hiccup form suitable for rendering on rich clients or rendering into an image)
- render/text : raw text suitable for substituting on clients when text is preferable. (Currently slack uses this for
scalar results where text is preferable to an image of a div of a single result."
[render-type timezone-id :- (s/maybe s/Str) card dashcard results]
(let [{title :content
title-attachments :attachments} (make-title-if-needed render-type card dashcard)
{description :content} (make-description-if-needed dashcard card)
results (update-in results
[:data :viz-settings]
(fn [viz-settings]
(merge viz-settings (mb.viz/db->norm
(:visualization_settings dashcard)))))
{pulse-body :content
body-attachments :attachments
text :render/text} (render-pulse-card-body render-type timezone-id card dashcard results)]
(cond-> {:attachments (merge title-attachments body-attachments)
:content [:p
;; Provide a horizontal scrollbar for tables that overflow container width.
;; Surrounding <p> element prevents buggy behavior when dragging scrollbar.
[:div {:style (style/style {:overflow-x :auto})}
[:a {:href (card-href card)
:target "_blank"
:rel "noopener noreferrer"
:style (style/style
(style/section-style)
{:display :block
:text-decoration :none})}
title
description
[:div {:class "pulse-body"
:style (style/style {:display :block
:margin :16px})}
(if-let [more-results-message (body/attached-results-text render-type card)]
(conj more-results-message (list pulse-body))
pulse-body)]]]]}
text (assoc :render/text text)))) | |
Same as | (defn render-pulse-card-for-display [timezone-id card results] (:content (render-pulse-card :inline timezone-id card nil results))) |
(s/defn render-pulse-section :- formatter/RenderedPulseCard
"Render a single Card section of a Pulse to a Hiccup form (representating HTML)."
[timezone-id {card :card, dashcard :dashcard, result :result}]
(let [{:keys [attachments content]} (binding [*include-title* true
*include-description* true]
(render-pulse-card :attachment timezone-id card dashcard result))]
{:attachments attachments
:content [:div {:style (style/style {:margin-top :20px
:margin-bottom :20px})}
content]})) | |
(s/defn render-pulse-card-to-png :- bytes "Render a `pulse-card` as a PNG. `data` is the `:data` from a QP result." [timezone-id :- (s/maybe s/Str) pulse-card result width] (png/render-html-to-png (render-pulse-card :inline timezone-id pulse-card nil result) width)) | |
(s/defn png-from-render-info :- bytes "Create a PNG file (as a byte array) from rendering info." [rendered-info :- formatter/RenderedPulseCard width] (png/render-html-to-png rendered-info width)) | |
(ns metabase.pulse.render.body (:require [clojure.string :as str] [hiccup.core :refer [h]] [medley.core :as m] [metabase.formatter :as formatter] [metabase.formatter.datetime :as datetime] [metabase.public-settings :as public-settings] [metabase.pulse.render.color :as color] [metabase.pulse.render.image-bundle :as image-bundle] [metabase.pulse.render.js-svg :as js-svg] [metabase.pulse.render.style :as style] [metabase.pulse.render.table :as table] [metabase.pulse.util :as pu] [metabase.query-processor.streaming :as qp.streaming] [metabase.shared.models.visualization-settings :as mb.viz] [metabase.types :as types] [metabase.util :as u] [metabase.util.i18n :refer [trs tru]] [metabase.util.ui-logic :as ui-logic] [schema.core :as s]) (:import (java.text DecimalFormat DecimalFormatSymbols))) | |
(set! *warn-on-reflection* true) | |
Default rendered-info map when there is an error running a card on the card run.
Is a delay due to the call to | (def ^:private card-error-rendered-info
(delay {:attachments
nil
:content
[:div {:style (style/style
(style/font-style)
{:color style/color-error
:font-weight 700
:padding :16px})}
(trs "There was a problem with this question.")]})) |
Default rendered-info map when there is an error displaying a card on the static viz side.
Is a delay due to the call to | (def ^:private error-rendered-info
(delay {:attachments
nil
:content
[:div {:style (style/style
(style/font-style)
{:color style/color-error
:font-weight 700
:padding :16px})}
(trs "An error occurred while displaying this card.")]})) |
NOTE: hiccup does not escape content by default so be sure to use "h" to escape any user-controlled content :-/ | |
+----------------------------------------------------------------------------------------------------------------+ | Helper Fns | +----------------------------------------------------------------------------------------------------------------+ | |
Should this column be shown in a rendered table in a Pulse? | (defn show-in-table?
[{:keys [semantic_type visibility_type] :as _column}]
(and (not (isa? semantic_type :type/Description))
(not (contains? #{:details-only :retired :sensitive} visibility_type)))) |
--------------------------------------------------- Formatting --------------------------------------------------- | |
(s/defn ^:private format-cell
[timezone-id :- (s/maybe s/Str) value col visualization-settings]
(cond
(types/temporal-field? col)
(datetime/format-temporal-str timezone-id value col)
(number? value)
(formatter/format-number value col visualization-settings)
:else
(str value))) | |
--------------------------------------------------- Rendering ---------------------------------------------------- | |
Creates a map with from column names to a column index. This is used to figure out what a given column name or value should be replaced with | (defn- create-remapping-lookup
[cols]
(into {}
(for [[col-idx {:keys [remapped_from]}] (map vector (range) cols)
:when remapped_from]
[remapped_from col-idx]))) |
Returns first column name from a hierarchy of possible column names | (defn- column-name
[card col]
(let [col-settings (-> (mb.viz/db->norm (:visualization_settings card))
::mb.viz/column-settings
;; field-ref keys can come in with additional stuff like :meta-data or unit maps,
;; so we select only those keys we CAN use to match with by using select-keys
(update-keys #(select-keys % [::mb.viz/column-name ::mb.viz/field-id])))]
(name (or (when-let [[_ id] (:field_ref col)]
(get-in col-settings [{::mb.viz/field-id id} ::mb.viz/column-title]))
(get-in col-settings [{::mb.viz/column-name (:name col)} ::mb.viz/column-title])
(:display_name col)
(:name col))))) |
Returns a row structure with header info from | (defn- query-results->header-row
[remapping-lookup card cols include-bar?]
{:row (for [maybe-remapped-col cols
:when (show-in-table? maybe-remapped-col)
:let [col (if (:remapped_to maybe-remapped-col)
(nth cols (get remapping-lookup (:name maybe-remapped-col)))
maybe-remapped-col)
col-name (column-name card col)]
;; If this column is remapped from another, it's already
;; in the output and should be skipped
:when (not (:remapped_from maybe-remapped-col))]
(if (isa? ((some-fn :effective_type :base_type) col) :type/Number)
(formatter/map->NumericWrapper {:num-str col-name :num-value col-name})
col-name))
:bar-width (when include-bar? 99)}) |
Normalizes bar-value into a value between 0 and 100, where 0 corresponds to | (defn- normalize-bar-value
[bar-value min-value max-value]
(float
(/
(* (- (double bar-value) min-value)
100)
(- max-value min-value)))) |
Returns a seq of stringified formatted rows that can be rendered into HTML | (s/defn ^:private query-results->row-seq
[timezone-id :- (s/maybe s/Str)
remapping-lookup
cols
rows
viz-settings
{:keys [bar-column min-value max-value]}]
(let [formatters (into []
(map #(formatter/create-formatter timezone-id % viz-settings))
cols)]
(for [row rows]
{:bar-width (some-> (and bar-column (bar-column row))
(normalize-bar-value min-value max-value))
:row (for [[maybe-remapped-col maybe-remapped-row-cell fmt-fn] (map vector cols row formatters)
:when (and (not (:remapped_from maybe-remapped-col))
(show-in-table? maybe-remapped-col))
:let [[_formatter row-cell] (if (:remapped_to maybe-remapped-col)
(let [remapped-index (get remapping-lookup (:name maybe-remapped-col))]
[(nth formatters remapped-index)
(nth row remapped-index)])
[fmt-fn maybe-remapped-row-cell])]]
(fmt-fn row-cell))}))) |
Convert the query results ( | (s/defn ^:private prep-for-html-rendering
([timezone-id :- (s/maybe s/Str) card data]
(prep-for-html-rendering timezone-id card data {}))
([timezone-id :- (s/maybe s/Str) card {:keys [cols rows viz-settings]}
{:keys [bar-column] :as data-attributes}]
(let [remapping-lookup (create-remapping-lookup cols)]
(cons
(query-results->header-row remapping-lookup card cols bar-column)
(query-results->row-seq
timezone-id
remapping-lookup
cols
(take (min (public-settings/attachment-table-row-limit) 100) rows)
viz-settings
data-attributes))))) |
(defn- strong-limit-text [number]
[:strong {:style (style/style {:color style/color-gray-3})} (h (formatter/format-number number))]) | |
(defn- render-truncation-warning
[row-limit row-count]
(let [over-row-limit (> row-count row-limit)]
(when over-row-limit
[:div {:style (style/style {:padding-top :16px})}
[:div {:style (style/style {:color style/color-gray-2
:padding-bottom :10px})}
"Showing " (strong-limit-text row-limit)
" of " (strong-limit-text row-count)
" rows."]]))) | |
Returns hiccup structures to indicate truncated results are available as an attachment | (defn attached-results-text
[render-type {:keys [include_csv include_xls]}]
(when (and (not= :inline render-type)
(or include_csv include_xls))
[:div {:style (style/style {:color style/color-gray-2
:margin-bottom :16px})}
(trs "Results have been included as a file attachment")])) |
+----------------------------------------------------------------------------------------------------------------+ | render | +----------------------------------------------------------------------------------------------------------------+ | |
Render a Pulse as | (defmulti render
{:arglists '([chart-type render-type timezone-id card dashcard data])}
(fn [chart-type _ _ _ _ _] chart-type)) |
(defn- order-data [data viz-settings]
(if (some? (::mb.viz/table-columns viz-settings))
(let [[ordered-cols output-order] (qp.streaming/order-cols (:cols data) viz-settings)
keep-filtered-idx (fn [row] (if output-order
(let [row-v (into [] row)]
(for [i output-order] (row-v i)))
row))
ordered-rows (map keep-filtered-idx (:rows data))]
[ordered-cols ordered-rows])
[(:cols data) (:rows data)])) | |
(s/defmethod render :table :- formatter/RenderedPulseCard
[_ _ timezone-id :- (s/maybe s/Str) card _dashcard {:keys [rows viz-settings] :as data}]
(let [[ordered-cols ordered-rows] (order-data data viz-settings)
data (-> data
(assoc :rows ordered-rows)
(assoc :cols ordered-cols))
table-body [:div
(table/render-table
(color/make-color-selector data viz-settings)
(mapv :name ordered-cols)
(prep-for-html-rendering timezone-id card data))
(render-truncation-warning (public-settings/attachment-table-row-limit) (count rows))]]
{:attachments
nil
:content
table-body})) | |
(def ^:private default-date-styles
{:year "YYYY"
:quarter "[Q]Q - YYYY"
:minute-of-hour "m"
:day-of-week "dddd"
:day-of-month "d"
:day-of-year "DDD"
:week-of-year "wo"
:month-of-year "MMMM"
:quarter-of-year "[Q]Q"}) | |
(def ^:private override-date-styles
{"M/D/YYYY" {:month "M/YYYY"}
"D/M/YYYY" {:month "M/YYYY"}
"YYYY/M/D" {:month "YYYY/M"
:quarter "YYYY - [Q]Q"}
"MMMM D, YYYY" {:month "MMMM, YYYY"}
"D MMMM, YYYY" {:month "MMMM, YYYY"}
"dddd, MMMM D, YYYY" {:day "EEEE, MMMM d, YYYY"
:week "MMMM d, YYYY"
:month "MMMM, YYYY"}}) | |
(defn- update-date-style
[date-style unit {::mb.viz/keys [date-abbreviate date-separator]}]
(let [unit (or unit :default)]
(cond-> (or (get-in override-date-styles [date-style unit])
(get default-date-styles unit)
date-style)
date-separator
(str/replace #"/" date-separator)
date-abbreviate
(-> (str/replace #"MMMM" "MMM")
(str/replace #"EEEE" "E"))))) | |
(defn- backfill-currency
[{:keys [number_style currency] :as settings}]
(cond-> settings
(and (= number_style "currency") (nil? currency))
(assoc :currency "USD"))) | |
(defn- update-col-for-js
[col-settings col]
(-> (m/map-keys (fn [k] (-> k name (str/replace #"-" "_") keyword)) col-settings)
(backfill-currency)
(u/update-if-exists :date_style update-date-style (:unit col) col-settings))) | |
(defn- settings-from-column
[col column-settings]
(-> (or (get column-settings {::mb.viz/field-id (:id col)})
(get column-settings {::mb.viz/column-name (:name col)}))
(update-col-for-js col))) | |
Include viz settings for js.
| (defn- ->js-viz
[x-col y-col {::mb.viz/keys [column-settings] :as viz-settings}]
(let [x-col-settings (settings-from-column x-col column-settings)
y-col-settings (settings-from-column y-col column-settings)]
(cond-> {:colors (public-settings/application-colors)
:visualization_settings (or viz-settings {})}
x-col-settings
(assoc :x x-col-settings)
y-col-settings
(assoc :y y-col-settings)))) |
Include viz settings for the typed settings, initially in XY charts. These are actually completely different than the previous settings format inasmuch: 1. The labels are in the settings 2. Colors are in the series, only the whitelabel colors are here 3. Many fewer things are optional 4. Must explicitly have yAxisPosition in all the series For further details look at frontend/src/metabase/static-viz/XYChart/types.ts | (defn- ->ts-viz
[x-col y-col labels {::mb.viz/keys [column-settings] :as viz-settings}]
(let [default-format {:number_style "decimal"
:currency "USD"
:currency_style "symbol"}
x-col-settings (or (settings-from-column x-col column-settings) {})
y-col-settings (or (settings-from-column y-col column-settings) {})
x-format (merge
(if (isa? (:effective_type x-col) :type/Temporal)
{:date_style "MMMM D, YYYY"}
default-format)
x-col-settings)
y-format (merge
default-format
y-col-settings)
default-x-type (if (isa? (:effective_type x-col) :type/Temporal)
"timeseries"
"ordinal")]
(merge
{:colors (public-settings/application-colors)
:stacking (if (:stackable.stack_type viz-settings) "stack" "none")
:x {:type (or (:graph.x_axis.scale viz-settings) default-x-type)
:format x-format}
:y {:type (or (:graph.y_axis.scale viz-settings) "linear")
:format y-format}
:labels labels
:visualization_settings (or viz-settings {})}
(when (:graph.show_goal viz-settings)
{:goal {:value (:graph.goal_value viz-settings)
:label (or (:graph.goal_label viz-settings) (tru "Goal"))}})))) |
Default stack type is stacked for area chart with more than one metric. So, if :stackable.stack_type is not specified, it's stacked. However, if key is explicitly set in :stackable.stack_type and is nil, that indicates not stacked. | (defn- set-default-stacked
[viz-settings card]
(let [stacked (if (contains? viz-settings :stackable.stack_type)
(= (:stackable.stack_type viz-settings) "stacked")
(and
(= (:display card) :area)
(or
(> (count (:graph.metrics viz-settings)) 1)
(> (count (:graph.dimensions viz-settings)) 1))))]
(if stacked
(assoc viz-settings :stackable.stack_type "stacked")
viz-settings))) |
Generate the X and Y axis labels passed in as the | (defn- x-and-y-axis-label-info
[x-col y-col viz-settings]
{:bottom (or (:graph.x_axis.title_text viz-settings)
(:display_name x-col))
:left (or (:graph.y_axis.title_text viz-settings)
(:display_name y-col))}) |
Returns | (defn- labels-enabled? [viz-settings axis-key] (boolean (get viz-settings axis-key true))) |
X and Y axis labels passed into the | (defn- combo-label-info
[x-cols y-cols viz-settings]
{:bottom (when (labels-enabled? viz-settings :graph.x_axis.labels_enabled)
(or (:graph.x_axis.title_text viz-settings)
(:display_name (first x-cols))))
:left (when (labels-enabled? viz-settings :graph.y_axis.labels_enabled)
(or (:graph.y_axis.title_text viz-settings)
(:display_name (first y-cols))))
:right (when (labels-enabled? viz-settings :graph.y_axis.labels_enabled)
(or (:graph.y_axis.title_text viz-settings)
(:display_name (second y-cols))))}) |
Colors to cycle through for charts. These are copied from https://stats.metabase.com/_internal/colors | (def ^:private colors ["#509EE3" "#88BF4D" "#A989C5" "#EF8C8C" "#F9D45C" "#F2A86F" "#98D9D9" "#7172AD" "#6450e3" "#4dbf5e" "#c589b9" "#efce8c" "#b5f95c" "#e35850" "#554dbf" "#bec589" "#8cefc6" "#5cc2f9" "#55e350" "#bf4d4f" "#89c3c5" "#be8cef" "#f95cd0" "#50e3ae" "#bf974d" "#899bc5" "#ef8cde" "#f95c67"]) |
Format a percentage which includes site settings for locale. The first arg is a numeric value to format. The second is an optional string of decimal and grouping symbols to be used, ie ".,". There will soon be a values.clj file that will handle this but this is here in the meantime. | (defn format-percentage
([value]
(format-percentage value (get-in (public-settings/custom-formatting) [:type/Number :number_separators])))
([value [decimal grouping]]
(let [base "#,###.##%"
fmt (if (or decimal grouping)
(DecimalFormat. base (doto (DecimalFormatSymbols.)
(cond-> decimal (.setDecimalSeparator decimal))
(cond-> grouping (.setGroupingSeparator grouping))))
(DecimalFormat. base))]
(.format fmt value)))) |
Process rows with a minimum slice threshold. Collapses any segments below the threshold given as a percentage (the value 25 for 25%) into a single category as "Other". | (defn- donut-info
[threshold-percentage rows]
(let [total (reduce + 0 (map second rows))
threshold (* total (/ threshold-percentage 100))
{as-is true clump false} (group-by (comp #(> % threshold) second) rows)
rows (cond-> as-is
(seq clump)
(conj [(tru "Other") (reduce (fnil + 0) 0 (map second clump))]))]
{:rows rows
:percentages (into {}
(for [[label value] rows]
[label (if (zero? total)
(tru "N/A")
(format-percentage (/ value total)))]))})) |
(defn- donut-legend
[legend-entries]
(letfn [(table-fn [entries]
(into [:table {:style (style/style {:color "#4C5773"
:font-family "Lato, sans-serif"
:font-size "24px"
:font-weight "bold"
:box-sizing "border-box"
:white-space "nowrap"})}]
(for [{:keys [label percentage color]} entries]
[:tr {:style (style/style {:margin-right "12px"})}
[:td {:style (style/style {:color color
:padding-right "7px"
:line-height "0"})}
[:span {:style (style/style {:font-size "2.875rem"
:line-height "0"
:position "relative"
:top "-4px"})} "•"]]
[:td {:style (style/style {:padding-right "30px"})}
label]
[:td percentage]])))]
(if (< (count legend-entries) 8)
(table-fn legend-entries)
[:table (into [:tr]
(map (fn [some-entries]
[:td {:style (style/style {:padding-right "20px"
:vertical-align "top"})}
(table-fn some-entries)])
(split-at (/ (count legend-entries) 2) legend-entries)))]))) | |
(defn- replace-nils [rows]
(mapv (fn [row]
(if (nil? (first row))
(assoc row 0 "(empty)")
row))
rows)) | |
(s/defmethod render :categorical/donut :- formatter/RenderedPulseCard
[_ render-type timezone-id :- (s/maybe s/Str) card _dashcard {:keys [rows cols viz-settings] :as data}]
(let [[x-axis-rowfn y-axis-rowfn] (formatter/graphing-column-row-fns card data)
rows (map (juxt (comp str x-axis-rowfn) y-axis-rowfn)
(formatter/row-preprocess x-axis-rowfn y-axis-rowfn (replace-nils rows)))
slice-threshold (or (get viz-settings :pie.slice_threshold)
2.5)
{:keys [rows percentages]} (donut-info slice-threshold rows)
legend-colors (merge (zipmap (map first rows) (cycle colors))
(update-keys (:pie.colors viz-settings) name))
settings {:percent_visibility (:pie.percent_visibility viz-settings) :show_total (:pie.show_total viz-settings)}
image-bundle (image-bundle/make-image-bundle
render-type
(js-svg/categorical-donut rows legend-colors settings))
{label-viz-settings :x} (->js-viz (x-axis-rowfn cols) (y-axis-rowfn cols) viz-settings)]
{:attachments
(when image-bundle
(image-bundle/image-bundle->attachment image-bundle))
:content
[:div
[:img {:style (style/style {:display :block :width :100%})
:src (:image-src image-bundle)}]
(donut-legend
(mapv (fn [row]
(let [label (first row)]
{:percentage (percentages (first row))
:color (legend-colors (first row))
:label (if (and (contains? label-viz-settings :date_style)
(datetime/temporal-string? label))
(datetime/format-temporal-str
timezone-id
(first row)
(x-axis-rowfn cols)
viz-settings)
label)}))
rows))]})) | |
(s/defmethod render :progress :- formatter/RenderedPulseCard
[_ render-type _timezone-id _card _dashcard {:keys [cols rows viz-settings] :as _data}]
(let [value (ffirst rows)
goal (:progress.goal viz-settings)
color (:progress.color viz-settings)
settings (assoc
(->js-viz (first cols) (first cols) viz-settings)
:color color)
;; ->js-viz fills in our :x but we actually want that under :format key
settings (assoc settings :format (:x settings))
image-bundle (image-bundle/make-image-bundle
render-type
(js-svg/progress value goal settings))]
{:attachments
(when image-bundle
(image-bundle/image-bundle->attachment image-bundle))
:content
[:div
[:img {:style (style/style {:display :block :width :100%})
:src (:image-src image-bundle)}]]})) | |
calculate the overlap, a value between 0 and 1, of the numerical ranges given by min-a = 0 max-a = 43 ----------------------------------------- min-b = 52 max-b = 75 ---------------------- The overlap above is 0. The mirror case where col-b is entirely less than col-a also has 0 overlap. Otherwise, overlap is calculated as follows: min-a = 0 max-a = 43 ----------------------------------------- | min-b = 8 | max-b = 59 | ---------------------------------|--------------- | | | | | |- overlap-width = (- 43 8) = 35 -| | | | |--------- max-width = (- 59 0) = 59 ---------------------| overlap = (/ overlap-width max-width) = (/ 35 59) = 0.59 Another scenario, with a similar result may look as follows: min-a = 0 max-a = 59 --------------------------------------------------------- | min-b = 8 max-b = 43 | | --------------------------------- | | | | | | |- overlap-width = (- 43 8) = 35 -| | | | |--------- max-width = (- 59 0) = 59 ---------------------| overlap = (/ overlap-width max-width) = (/ 35 59) = 0.59 | (defn- overlap
[vals-a vals-b]
(let [[min-a max-a] (-> vals-a sort ((juxt first last)))
[min-b max-b] (-> vals-b sort ((juxt first last)))
[a b c d] (sort [min-a min-b max-a max-b])
max-width (- d a)
overlap-width (- c b)]
(/ (double overlap-width) (double max-width)))) |
Calculate the 'nearness' score for ranges specified by The nearness score is the percent of the total range that the 'valid range' covers IF, the outer point's distance to the nearest range end covers less of the total range. for visual: * -------------- <---- the 'pt' on the left is close enough. | (defn- nearness
[vals-a vals-b]
(let [[min-a max-a] (-> vals-a sort ((juxt first last)))
[min-b max-b] (-> vals-b sort ((juxt first last)))]
(cond
(or (= min-a max-a) (= min-b max-b))
(let [pt (if (= min-a max-a) min-a min-b)
[r1 r2] (if (= min-a max-a) [min-b max-b] [min-a max-a])
total-range (- (max pt r2) (min pt r1))
valid-range-score (/ (- r2 r1) total-range)
outer-pt-score (/ (min (abs (- pt r1))
(abs (- pt r2)))
total-range)]
(if (>= valid-range-score outer-pt-score)
(double valid-range-score)
0))
:else 0))) |
Calculate the axis grouping threshold value for the ranges specified by | (defn- axis-group-score
[vals-a vals-b]
(let [[min-a max-a] (-> vals-a sort ((juxt first last)))
[min-b max-b] (-> vals-b sort ((juxt first last)))]
(cond
;; any nils in the ranges means we can't compare them.
(some nil? (concat vals-a vals-b)) 0
;; if either range is just a single point, and it's inside the other range,
;; we consider it overlapped. Not likely in practice, but could happen.
(and (= min-a max-a) (<= min-b min-a max-b)) 1
(and (= min-b max-b) (<= min-a min-b max-a)) 1
;; ranges overlap, let's calculate the percent overlap
(or (<= min-a min-b max-a)
(<= min-a max-b max-a)) (overlap vals-a vals-b)
;; no overlap, let's calculate a nearness value to use instead
:else (nearness vals-a vals-b)))) |
Default chart type seq of combo graphs (not multiple graphs). | (def default-combo-chart-types
(conj (repeat "bar")
"line")) |
(defn- attach-image-bundle
[image-bundle]
{:attachments
(when image-bundle
(image-bundle/image-bundle->attachment image-bundle))
:content
[:div
[:img {:style (style/style {:display :block
:width :100%})
:src (:image-src image-bundle)}]]}) | |
(defn- multiple-scalar-series
[joined-rows _x-cols _y-cols _viz-settings]
[(for [[row-val] (map vector joined-rows)]
{:cardName (first row-val)
:type :bar
:data [row-val]
:yAxisPosition "left"
:column nil})]) | |
When multiple scalar cards are combined, they render as a bar chart | (defn- render-multiple-scalars
[render-type card dashcard {:keys [viz-settings] :as data}]
(let [multi-res (pu/execute-multi-card card dashcard)
cards (cons card (map :card multi-res))
multi-data (cons data (map #(get-in % [:result :data]) multi-res))
x-rows (map :name cards) ;; Bar labels
y-rows (mapcat :rows multi-data)
x-cols [{:base_type :type/Text
:effective_type :type/Text}]
y-cols (select-keys (first (:cols data)) [:base_type :effective_type])
series-seqs (multiple-scalar-series (mapv vector x-rows (flatten y-rows)) x-cols y-cols viz-settings)
labels (combo-label-info x-cols y-cols viz-settings)
settings (->ts-viz (first x-cols) (first y-cols) labels viz-settings)]
(attach-image-bundle (image-bundle/make-image-bundle render-type (js-svg/combo-chart series-seqs settings))))) |
(defn- series-setting [viz-settings outer-key inner-key] (get-in viz-settings [:series_settings (keyword outer-key) inner-key])) | |
(def ^:private axis-group-threshold 0.33) | |
(defn- group-axes-at-once
[joined-rows viz-settings]
(let [;; a double-x-axis 'joined-row' looks like:
;; [["val on x-axis" "grouping-key"] [series-val]] eg:
;; [["2016-01-01T00:00:00Z" "Doohickey" ] [9031.5578 ]]
;; a single-x-axis 'joined-row' looks like:
;; [[grouping-key] [series-val-1 series-val-2 ...]]
joined-rows-map (if (= (count (ffirst joined-rows)) 2)
;; double-x-axis
(-> (group-by (fn [[[_ x2] _]] x2) joined-rows)
(update-vals #(mapcat last %)))
;; single-x-axis
(->> (:graph.metrics viz-settings)
(map-indexed (fn [idx k]
[k (mapv #(get (second %) idx) joined-rows)]))
(into {})))
;; map of group-key -> :left :right or nil
starting-positions (into {} (for [k (keys joined-rows-map)]
[k (or (keyword (series-setting viz-settings k :axis)) :unassigned)]))
;; map of position (:left :right or :unassigned) -> vector of assigned groups
positions (-> (group-by second starting-positions)
(update-vals #(mapv first %)))
unassigned? (contains? positions :unassigned)
stacked? (boolean (:stackable.stack_type viz-settings))]
(cond
;; if the chart is stacked, splitting the axes doesn't make sense, so we always put every series :left
stacked? (into {} (map (fn [k] [k :left]) (keys joined-rows-map)))
;; chart is not stacked, and there are some :unassigned series, so we try to group them
unassigned?
(let [lefts (or (:left positions) [(first (:unassigned positions))])
rights (or (:right positions) [])
to-group (remove (set (concat lefts rights)) (:unassigned positions))
score-fn (fn [series-vals]
(into {} (map (fn [k]
[k (axis-group-score (get joined-rows-map k) series-vals)])
(keys joined-rows-map))))
;; with the first series assigned :left, calculate scores between that series and all other series
scores (score-fn (get joined-rows-map (first lefts)))
;; group the series by comparing the score for that series against the group threshold
all-positions (apply (partial merge-with concat)
(conj
(for [k to-group]
(if (> (get scores k) axis-group-threshold)
{:left [k]}
{:right [k]}))
(-> positions (dissoc :unassigned) (assoc :left lefts))))]
(into {} (apply concat (for [[pos ks] all-positions]
(map (fn [k] [k pos]) ks)))))
;; all series already have positions assigned
;; This comes from the user explicitly setting left or right on the series in the UI.
:else positions))) | |
This munges rows and columns into series in the format that we want for combo staticviz for literal combo displaytype, for a single x-axis with multiple y-axis. | (defn- single-x-axis-combo-series
[chart-type joined-rows _x-cols y-cols {:keys [viz-settings] :as _data} card-name]
(let [positions (group-axes-at-once joined-rows viz-settings)]
(for [[idx y-col] (map-indexed vector y-cols)]
(let [y-col-key (:name y-col)
card-type (or (series-setting viz-settings y-col-key :display)
chart-type
(nth default-combo-chart-types idx))
selected-rows (mapv #(vector (ffirst %) (nth (second %) idx)) joined-rows)
y-axis-pos (get positions y-col-key "left")]
{:cardName card-name
:type card-type
:data selected-rows
:yAxisPosition y-axis-pos
:column y-col})))) |
This munges rows and columns into series in the format that we want for combo staticviz for literal combo displaytype, for a double x-axis, which has pretty materially different semantics for that second dimension, with single y-axis only. This mimics default behavior in JS viz, which is to group by the second dimension and make every group-by-value a series. This can have really high cardinality of series but the JS viz will complain about more than 100 already | (defn- double-x-axis-combo-series
[chart-type joined-rows x-cols _y-cols {:keys [viz-settings] :as _data} card-name]
(let [grouped-rows (group-by #(second (first %)) joined-rows)
groups (keys grouped-rows)
positions (group-axes-at-once joined-rows viz-settings)]
(for [[idx group-key] (map-indexed vector groups)]
(let [row-group (get grouped-rows group-key)
selected-row-group (mapv #(vector (ffirst %) (first (second %))) row-group)
card-type (or (series-setting viz-settings group-key :display)
chart-type
(nth default-combo-chart-types idx))
y-axis-pos (get positions group-key)]
{:cardName card-name
:type card-type
:data selected-row-group
:yAxisPosition y-axis-pos
:column (second x-cols)
:breakoutValue group-key})))) |
(defn- axis-row-fns [card data] [(or (ui-logic/mult-x-axis-rowfn card data) #(vector (first %))) (or (ui-logic/mult-y-axis-rowfn card data) #(vector (second %)))]) | |
Helper function for | (defn- card-result->series
[result]
(let [card (:card result)
data (get-in result [:result :data])
display (:display card)
[x-fn y-fn] (axis-row-fns card data)
enforced-type (if (= display :scalar) :bar display)
card-name (:name card)
viz-settings (:visualization_settings card)
joined-rows (map (juxt x-fn y-fn)
(formatter/row-preprocess x-fn y-fn (:rows data)))
[x-cols y-cols] ((juxt x-fn y-fn) (get-in result [:result :data :cols]))
combo-series-fn (if (= (count x-cols) 1) single-x-axis-combo-series double-x-axis-combo-series)]
(combo-series-fn enforced-type joined-rows x-cols y-cols viz-settings card-name))) |
When multiple non-scalar cards are combined, render them as a line, area, or bar chart | (defn- render-multiple-lab-chart
[render-type card dashcard {:keys [viz-settings] :as data}]
(let [multi-res (pu/execute-multi-card card dashcard)
;; multi-res gets the other results from the set of multis.
;; we shove cards and data here all together below for uniformity's sake
viz-settings (set-default-stacked viz-settings card)
multi-data (cons data (map #(get-in % [:result :data]) multi-res))
col-seqs (map :cols multi-data)
[x-fn y-fn] (axis-row-fns card data)
[[x-col] [y-col]] ((juxt x-fn y-fn) (first col-seqs))
labels (x-and-y-axis-label-info x-col y-col viz-settings)
settings (->ts-viz x-col y-col labels viz-settings)
series-seqs (map card-result->series (cons {:card card :result {:data data}} multi-res))]
(attach-image-bundle (image-bundle/make-image-bundle render-type (js-svg/combo-chart series-seqs settings))))) |
Generate an image-bundle for a Line Area Bar chart (LAB) Use the combo charts for every chart-type in line area bar because we get multiple chart series for cheaper this way. | (defn- lab-image-bundle
[chart-type render-type _timezone-id card {:keys [cols rows viz-settings] :as data}]
(let [rows (replace-nils rows)
x-axis-rowfn (or (ui-logic/mult-x-axis-rowfn card data) #(vector (first %)))
y-axis-rowfn (or (ui-logic/mult-y-axis-rowfn card data) #(vector (second %)))
x-rows (filter some? (map x-axis-rowfn rows))
y-rows (filter some? (map y-axis-rowfn rows))
joined-rows (mapv vector x-rows y-rows)
viz-settings (set-default-stacked viz-settings card)
[x-cols y-cols] ((juxt x-axis-rowfn y-axis-rowfn) (vec cols))
enforced-type (if (= chart-type :combo)
nil
chart-type)
card-name (:name card)
;; NB: There's a hardcoded limit of arity 2 on x-axis, so there's only the 1-axis or 2-axis case
series-seqs [(if (= (count x-cols) 1)
(single-x-axis-combo-series enforced-type joined-rows x-cols y-cols data card-name)
(double-x-axis-combo-series enforced-type joined-rows x-cols y-cols data card-name))]
labels (combo-label-info x-cols y-cols viz-settings)
settings (->ts-viz (first x-cols) (first y-cols) labels viz-settings)]
(image-bundle/make-image-bundle
render-type
(js-svg/combo-chart series-seqs settings)))) |
(s/defmethod render :multiple
[_ render-type _timezone-id card dashcard data]
((if (= :scalar (:display card))
render-multiple-scalars
render-multiple-lab-chart)
render-type card dashcard data)) | |
(s/defmethod render :line :- formatter/RenderedPulseCard [_ render-type timezone-id card _dashcard data] (attach-image-bundle (lab-image-bundle :line render-type timezone-id card data))) | |
(s/defmethod render :area :- formatter/RenderedPulseCard [_ render-type timezone-id card _dashcard data] (attach-image-bundle (lab-image-bundle :area render-type timezone-id card data))) | |
(s/defmethod render :bar :- formatter/RenderedPulseCard [_chart-type render-type timezone-id :- (s/maybe s/Str) card _dashcard data] (attach-image-bundle (lab-image-bundle :bar render-type timezone-id card data))) | |
(s/defmethod render :combo :- formatter/RenderedPulseCard [_chart-type render-type timezone-id :- (s/maybe s/Str) card _dashcard data] (attach-image-bundle (lab-image-bundle :combo render-type timezone-id card data))) | |
(s/defmethod render :gauge :- formatter/RenderedPulseCard
[_chart-type render-type _timezone-id :- (s/maybe s/Str) card _dashcard data]
(let [image-bundle (image-bundle/make-image-bundle
render-type
(js-svg/gauge card data))]
{:attachments
(when image-bundle
(image-bundle/image-bundle->attachment image-bundle))
:content
[:div
[:img {:style (style/style {:display :block :width :100%})
:src (:image-src image-bundle)}]]})) | |
(s/defmethod render :row :- formatter/RenderedPulseCard
[_ render-type _timezone-id card _dashcard {:keys [rows cols] :as _data}]
(let [viz-settings (get card :visualization_settings)
data {:rows rows
:cols cols}
image-bundle (image-bundle/make-image-bundle
render-type
(js-svg/row-chart viz-settings data))]
{:attachments
(when image-bundle
(image-bundle/image-bundle->attachment image-bundle))
:content
[:div
[:img {:style (style/style {:display :block :width :100%})
:src (:image-src image-bundle)}]]})) | |
(defn- get-col-by-name
[cols col-name]
(->> (map-indexed (fn [idx m] [idx m]) cols)
(some (fn [[idx col]]
(when (= col-name (:name col))
[idx col]))))) | |
(s/defmethod render :scalar :- formatter/RenderedPulseCard
[_chart-type _render-type timezone-id _card _dashcard {:keys [cols rows viz-settings]}]
(let [field-name (:scalar.field viz-settings)
[row-idx col] (or (when field-name
(get-col-by-name cols field-name))
[0 (first cols)])
row (first rows)
raw-value (get row row-idx)
value (format-cell timezone-id raw-value col viz-settings)]
{:attachments
nil
:content
[:div {:style (style/style (style/scalar-style))}
(h value)]
:render/text (str value)})) | |
(s/defmethod render :javascript_visualization :- formatter/RenderedPulseCard
[_ render-type _timezone-id card dashcard data]
(let [combined-cards-results (pu/execute-multi-card card dashcard)
cards-with-data (map (fn [c d] {:card c :data d})
(cons card (map :card combined-cards-results))
(cons data (map #(get-in % [:result :data]) combined-cards-results)))
dashcard-viz-settings (get dashcard :visualization_settings)
{rendered-type :type content :content} (js-svg/javascript-visualization cards-with-data dashcard-viz-settings)]
(case rendered-type
:svg
(let [image-bundle (image-bundle/make-image-bundle
render-type
(js-svg/svg-string->bytes content))]
{:attachments
(when image-bundle
(image-bundle/image-bundle->attachment image-bundle))
:content
[:div
[:img {:style (style/style {:display :block :width :100%})
:src (:image-src image-bundle)}]]})
:html
{:content [:div content] :attachments nil}))) | |
(s/defmethod render :smartscalar :- formatter/RenderedPulseCard
[_chart-type _render-type timezone-id _card _dashcard {:keys [cols insights viz-settings]}]
(letfn [(col-of-type [t c] (or (isa? (:effective_type c) t)
;; computed and agg columns don't have an effective type
(isa? (:base_type c) t)))
(where [f coll] (some #(when (f %) %) coll))
(percentage [arg] (if (number? arg)
(format-percentage arg)
" - "))
(format-unit [unit] (str/replace (name unit) "-" " "))]
(let [[_time-col metric-col] (if (col-of-type :type/Temporal (first cols)) cols (reverse cols))
{:keys [last-value previous-value unit last-change] :as _insight}
(where (comp #{(:name metric-col)} :col) insights)]
(if (and last-value previous-value unit last-change)
(let [value (format-cell timezone-id last-value metric-col viz-settings)
previous (format-cell timezone-id previous-value metric-col viz-settings)
adj (if (pos? last-change) (tru "Up") (tru "Down"))
delta-statement (if (= last-value previous-value)
"No change"
(str adj " " (percentage last-change)))
comparison-statement (str " vs. previous " (format-unit unit) ": " previous)]
{:attachments nil
:content [:div
[:div {:style (style/style (style/scalar-style))}
(h value)]
[:p {:style (style/style {:color style/color-text-medium
:font-size :16px
:font-weight 700
:padding-right :16px})}
delta-statement
comparison-statement]]
:render/text (str value "\n"
delta-statement
comparison-statement)})
;; In other words, defaults to plain scalar if we don't have actual changes
{:attachments nil
:content [:div
[:div {:style (style/style (style/scalar-style))}
(h last-value)]
[:p {:style (style/style {:color style/color-text-medium
:font-size :16px
:font-weight 700
:padding-right :16px})}
(trs "Nothing to compare to.")]]
:render/text (str (format-cell timezone-id last-value metric-col viz-settings)
"\n" (trs "Nothing to compare to."))})))) | |
(s/defmethod render :waterfall :- formatter/RenderedPulseCard
[_ render-type _timezone-id card _dashcard {:keys [rows cols viz-settings] :as data}]
(let [[x-axis-rowfn
y-axis-rowfn] (formatter/graphing-column-row-fns card data)
[x-col y-col] ((juxt x-axis-rowfn y-axis-rowfn) cols)
rows (map (juxt x-axis-rowfn y-axis-rowfn)
(formatter/row-preprocess x-axis-rowfn y-axis-rowfn rows))
labels (x-and-y-axis-label-info x-col y-col viz-settings)
waterfall-type (if (isa? (-> cols x-axis-rowfn :effective_type) :type/Temporal)
:timeseries
:categorical)
show-total (if (nil? (:waterfall.show_total viz-settings))
true
(:waterfall.show_total viz-settings))
settings (-> (->js-viz x-col y-col viz-settings)
(update :colors assoc
:waterfallTotal (:waterfall.total_color viz-settings)
:waterfallPositive (:waterfall.increase_color viz-settings)
:waterfallNegative (:waterfall.decrease_color viz-settings))
(assoc :showTotal show-total)
(assoc :show_values (boolean (:graph.show_values viz-settings))))
image-bundle (image-bundle/make-image-bundle
render-type
(js-svg/waterfall rows
labels
settings
waterfall-type))]
{:attachments
(when image-bundle
(image-bundle/image-bundle->attachment image-bundle))
:content
[:div
[:img {:style (style/style {:display :block :width :100%})
:src (:image-src image-bundle)}]]})) | |
(s/defmethod render :funnel :- formatter/RenderedPulseCard
[_ render-type _timezone-id card _dashcard {:keys [rows cols viz-settings] :as data}]
(let [[x-axis-rowfn
y-axis-rowfn] (formatter/graphing-column-row-fns card data)
funnel-rows (:funnel.rows viz-settings)
raw-rows (map (juxt x-axis-rowfn y-axis-rowfn)
(formatter/row-preprocess x-axis-rowfn y-axis-rowfn rows))
rows (cond->> raw-rows
funnel-rows (mapv (fn [[idx val]]
[(get-in funnel-rows [(dec idx) :key]) val])))
[x-col y-col] cols
settings (as-> (->js-viz x-col y-col viz-settings) jsviz-settings
(assoc jsviz-settings :step {:name (:display_name x-col)
:format (:x jsviz-settings)}
:measure {:format (:y jsviz-settings)}))
svg (js-svg/funnel rows settings)
image-bundle (image-bundle/make-image-bundle render-type svg)]
{:attachments
(image-bundle/image-bundle->attachment image-bundle)
:content
[:div
[:img {:style (style/style {:display :block :width :100%})
:src (:image-src image-bundle)}]]})) | |
(s/defmethod render :empty :- formatter/RenderedPulseCard
[_ render-type _ _ _ _]
(let [image-bundle (image-bundle/no-results-image-bundle render-type)]
{:attachments
(image-bundle/image-bundle->attachment image-bundle)
:content
[:div {:style (style/style {:text-align :center})}
[:img {:style (style/style {:width :104px})
:src (:image-src image-bundle)}]
[:div {:style (style/style
(style/font-style)
{:margin-top :8px
:color style/color-gray-4})}
(trs "No results")]]
:render/text (trs "No results")})) | |
(s/defmethod render :attached :- formatter/RenderedPulseCard
[_ render-type _ _ _ _]
(let [image-bundle (image-bundle/attached-image-bundle render-type)]
{:attachments
(image-bundle/image-bundle->attachment image-bundle)
:content
[:div {:style (style/style {:text-align :center})}
[:img {:style (style/style {:width :30px})
:src (:image-src image-bundle)}]
[:div {:style (style/style
(style/font-style)
{:margin-top :8px
:color style/color-gray-4})}
(trs "This question has been included as a file attachment")]]})) | |
(s/defmethod render :unknown :- formatter/RenderedPulseCard
[_ _ _ _ _ _]
{:attachments
nil
:content
[:div {:style (style/style
(style/font-style)
{:color style/color-gold
:font-weight 700})}
(trs "We were unable to display this Pulse.")
[:br]
(trs "Please view this card in Metabase.")]}) | |
(s/defmethod render :card-error :- formatter/RenderedPulseCard [_ _ _ _ _ _] @card-error-rendered-info) | |
(s/defmethod render :render-error :- formatter/RenderedPulseCard [_ _ _ _ _ _] @error-rendered-info) | |
Namespaces that uses the Nashorn javascript engine to invoke some shared javascript code that we use to determine the background color of pulse table cells | (ns metabase.pulse.render.color
(:require
[cheshire.core :as json]
[clojure.java.io :as io]
[metabase.formatter]
[metabase.pulse.render.js-engine :as js]
[metabase.util.i18n :refer [trs]]
[schema.core :as s])
(:import
(metabase.formatter NumericWrapper))) |
(set! *warn-on-reflection* true) | |
(def ^:private js-file-path "frontend_shared/color_selector.js") | |
(def ^:private ^{:arglists '([])} js-engine
;; The code that loads the JS engine is behind a delay so that we don't incur that cost on startup. The below
;; assertion till look for the javascript file at startup and fail if it doesn't find it. This is to avoid a big
;; delay in finding out that the system is broken
(let [file-url (io/resource js-file-path)]
(assert file-url (trs "Can''t find JS color selector at ''{0}''" js-file-path))
(let [dlay (delay
(doto (js/context)
(js/load-resource js-file-path)))]
(fn []
@dlay)))) | |
This is a pretty loose schema, more as a safety net as we have a long feedback loop for this being broken as it's
being handed to the JS color picking code. Currently it just needs column names from | (def ^:private QueryResults
{:cols [{:name s/Str
s/Any s/Any}]
:rows [[s/Any]]
s/Any s/Any}) |
Returns a curried javascript function (object) that can be used with Get the correct color for a cell in a pulse table. Returns color as string suitable for use CSS, e.g. a hex string or
| (s/defn make-color-selector
[{:keys [cols rows]} :- QueryResults viz-settings]
;; Ideally we'd convert everything to JS data before invoking the function below, but converting rows would be
;; expensive. The JS code is written to deal with `rows` in it's native Nashorn format but since `cols` and
;; `viz-settings` are small, pass those as JSON so that they can be deserialized to pure JS objects once in JS
;; code
(js/execute-fn-name (js-engine) "makeCellBackgroundGetter"
rows
(json/generate-string cols)
(json/generate-string viz-settings)))
(defn get-background-color
^String [color-selector cell-value column-name row-index]
(let [cell-value (if (instance? NumericWrapper cell-value)
(:num-value cell-value)
cell-value)]
(.asString (js/execute-fn color-selector cell-value row-index column-name)))) |
Logic related to creating image bundles, and some predefined ones. An image bundle contains the data needed to
either encode the image inline in a URL (when | (ns metabase.pulse.render.image-bundle (:require [clojure.java.io :as io]) (:import (java.util Arrays) (org.apache.commons.io IOUtils) (org.fit.cssbox.misc Base64Coder))) |
(set! *warn-on-reflection* true) | |
Generate a hash to be used in a Content-ID | (defn- hash-bytes [^bytes img-bytes] (Math/abs ^Integer (Arrays/hashCode img-bytes))) |
Generate a hash to be used in a Content-ID | (defn- hash-image-url [^java.net.URL url] (-> url io/input-stream IOUtils/toByteArray hash-bytes)) |
(defn- content-id-reference [content-id] (str "cid:" content-id)) | |
(defn- mb-hash-str [image-hash] (str image-hash "@metabase")) | |
(defn- write-byte-array-to-temp-file
[^bytes img-bytes]
(let [f (doto (java.io.File/createTempFile "metabase_pulse_image_" ".png")
.deleteOnExit)]
(with-open [fos (java.io.FileOutputStream. f)]
(.write fos img-bytes))
f)) | |
(defn- byte-array->url [^bytes img-bytes] (-> img-bytes write-byte-array-to-temp-file io/as-url)) | |
Takes a PNG byte array and returns a Base64 encoded URI | (defn render-img-data-uri [img-bytes] (str "data:image/png;base64," (String. (Base64Coder/encode img-bytes)))) |
Create an image bundle. An image bundle contains the data needed to either encode the image inline (when
| (defmulti make-image-bundle
(fn [render-type url-or-bytes]
[render-type (class url-or-bytes)])) |
(defmethod make-image-bundle [:attachment java.net.URL]
[render-type, ^java.net.URL url]
(let [content-id (mb-hash-str (hash-image-url url))]
{:content-id content-id
:image-url url
:image-src (content-id-reference content-id)
:render-type render-type})) | |
(defmethod make-image-bundle [:attachment (class (byte-array 0))]
[render-type image-bytes]
(let [image-url (byte-array->url image-bytes)
content-id (mb-hash-str (hash-bytes image-bytes))]
{:content-id content-id
:image-url image-url
:image-src (content-id-reference content-id)
:render-type render-type})) | |
(defmethod make-image-bundle [:inline java.net.URL]
[render-type, ^java.net.URL url]
{:image-src (-> url io/input-stream IOUtils/toByteArray render-img-data-uri)
:image-url url
:render-type render-type}) | |
(defmethod make-image-bundle [:inline (Class/forName "[B")]
[render-type image-bytes]
{:image-src (render-img-data-uri image-bytes)
:render-type render-type}) | |
(def ^:private external-link-url (io/resource "frontend_client/app/assets/img/external_link.png")) (def ^:private no-results-url (io/resource "frontend_client/app/assets/img/pulse_no_results@2x.png")) (def ^:private attached-url (io/resource "frontend_client/app/assets/img/attachment@2x.png")) | |
(def ^:private external-link-image (delay (make-image-bundle :attachment external-link-url))) | |
(def ^:private no-results-image (delay (make-image-bundle :attachment no-results-url))) | |
(def ^:private attached-image
(delay
(make-image-bundle :attachment attached-url))) | |
Image bundle for an external link icon. | (defn external-link-image-bundle
[render-type]
(case render-type
:attachment @external-link-image
:inline (make-image-bundle render-type external-link-url))) |
Image bundle for the 'No results' image. | (defn no-results-image-bundle
[render-type]
(case render-type
:attachment @no-results-image
:inline (make-image-bundle render-type no-results-url))) |
Image bundle for paperclip 'attachment' image. | (defn attached-image-bundle
[render-type]
(case render-type
:attachment @attached-image
:inline (make-image-bundle render-type attached-url))) |
Convert an image bundle into an email attachment. | (defn image-bundle->attachment
[{:keys [render-type content-id image-url]}]
(case render-type
:attachment {content-id image-url}
:inline nil)) |
Graal polyglot context suitable for executing javascript code. We run the js in interpreted mode and turn off the warning with the `(option "engine.WarnInterpreterOnly" "false")`. Ideally we would compile the javascript but this is difficult when using the graal ecosystem in a non graal jdk. See https://github.com/oracle/graaljs/blob/master/docs/user/RunOnJDK.md for more information. Javadocs: https://www.graalvm.org/truffle/javadoc/overview-summary.html | (ns metabase.pulse.render.js-engine (:require [clojure.java.io :as io] [metabase.util.i18n :refer [trs]]) (:import (org.graalvm.polyglot Context HostAccess Source Value))) |
(set! *warn-on-reflection* true) | |
Create a new org.graalvm.polyglot.Context suitable to evaluate javascript | (defn context
^Context []
(.. (Context/newBuilder (into-array String ["js"]))
;; https://github.com/oracle/graaljs/blob/master/docs/user/RunOnJDK.md
(option "engine.WarnInterpreterOnly" "false")
(option "js.intl-402" "true")
(allowHostAccess HostAccess/ALL)
(allowHostClassLookup (reify java.util.function.Predicate
(test [_ _] true)))
(out System/out)
(err System/err)
(allowIO true)
(build))) |
Load a string literal source into the js context. | (defn load-js-string [^Context context ^String string-src ^String src-name] (.eval context (.buildLiteral (Source/newBuilder "js" string-src src-name)))) |
Load a resource into the js context | (defn load-resource
[^Context context source]
(let [resource (io/resource source)]
(when (nil? resource)
(throw (ex-info (trs "Javascript resource not found: {0}" source)
{:source source})))
(.eval context (.build (Source/newBuilder "js" resource))))) |
Executes | (defn execute-fn-name
^Value [^Context context js-fn-name & args]
(let [fn-ref (.eval context "js" js-fn-name)
args (into-array Object args)]
(assert (.canExecute fn-ref) (str "cannot execute " js-fn-name))
(.execute fn-ref args))) |
fn-ref should be an executable org.graalvm.polyglot.Value return from a js engine. Invoke this function with args. | (defn execute-fn ^Value [^Value fn-ref & args] (assert (.canExecute fn-ref) "cannot execute function reference") (.execute fn-ref (object-array args))) |
Functions to render charts as svg strings by using graal's js engine. A bundle is built by | (ns metabase.pulse.render.js-svg (:require [cheshire.core :as json] [clojure.string :as str] [metabase.config :as config] [metabase.public-settings :as public-settings] [metabase.pulse.render.js-engine :as js] [metabase.pulse.render.style :as style]) (:import (java.io ByteArrayInputStream ByteArrayOutputStream) (java.nio.charset StandardCharsets) (org.apache.batik.anim.dom SAXSVGDocumentFactory SVGOMDocument) (org.apache.batik.transcoder TranscoderInput TranscoderOutput) (org.apache.batik.transcoder.image PNGTranscoder) (org.graalvm.polyglot Context) (org.w3c.dom Element Node))) |
(set! *warn-on-reflection* true) | |
the bundle path goes through webpack. Changes require a | (def ^:private bundle-path "frontend_client/app/dist/lib-static-viz.bundle.js") |
the interface file does not go through webpack. Feel free to quickly change as needed and then re-require this
namespace to redef the | (def ^:private interface-path "frontend_shared/static_viz_interface.js") |
(defn- load-viz-bundle [^Context context]
(doto context
(js/load-resource bundle-path)
(js/load-resource interface-path))) | |
Delay containing a graal js context. It has the chart bundle and the above | (def ^:private static-viz-context-delay ;; todo is this thread safe? Should we have a resource pool on top of this? Or create them fresh for each invocation (delay (load-viz-bundle (js/context)))) |
Returns a static viz context. In dev mode, this will be a new context each time. In prod or test modes, it will
return the derefed contents of | (defn- context
^Context []
(if config/is-dev?
(load-viz-bundle (js/context))
@static-viz-context-delay)) |
Mutate in place the elements of the svg document. Remove the fill=transparent attribute in favor of fill-opacity=0.0. Our svg image renderer only understands the latter. Mutation is unfortunately necessary as the underlying tree of nodes is inherently mutable | (defn- post-process
[^SVGOMDocument svg-document & post-fns]
(loop [s [(.getDocumentElement svg-document)]]
(when-let [^Node node (peek s)]
(let [s' (let [nodelist (.getChildNodes node)
length (.getLength nodelist)]
(apply conj (pop s)
;; reverse the nodes for the stack so it goes down first child first
(map #(.item nodelist %) (reverse (range length)))))]
(reduce (fn [node f] (f node)) node post-fns)
(recur s'))))
svg-document) |
The batik svg renderer does not understand fill="transparent" so we must change that to fill-opacity="0.0". Previously was just doing a string replacement but now is a proper tree walk fix. | (defn- fix-fill
[^Node node]
(letfn [(element? [x] (instance? Element x))]
(if (and (element? node)
(.hasAttribute ^Element node "fill")
(= (.getAttribute ^Element node "fill") "transparent"))
(doto ^Element node
(.removeAttribute "fill")
(.setAttribute "fill-opacity" "0.0"))
node))) |
(defn- parse-svg-string [^String s]
(let [s (str/replace s #"<svg" "<svg xmlns=\"http://www.w3.org/2000/svg\)
factory (SAXSVGDocumentFactory. "org.apache.xerces.parsers.SAXParser")]
(with-open [is (ByteArrayInputStream. (.getBytes s StandardCharsets/UTF_8))]
(.createDocument factory "file:///fake.svg" is)))) | |
Width to render svg images. Intentionally large to improve quality. Consumers should be aware and resize as needed. Email should include width tags; slack automatically resizes inline and provides a nice detail view when clicked. | (def ^:dynamic ^:private *svg-render-width* (float 1200)) |
Height to render svg images. If not bound, will preserve aspect ratio of original image. | (def ^:dynamic ^:private *svg-render-height* nil) |
(defn- render-svg
^bytes [^SVGOMDocument svg-document]
(style/register-fonts-if-needed!)
(with-open [os (ByteArrayOutputStream.)]
(let [^SVGOMDocument fixed-svg-doc (post-process svg-document fix-fill)
in (TranscoderInput. fixed-svg-doc)
out (TranscoderOutput. os)
transcoder (PNGTranscoder.)]
(.addTranscodingHint transcoder PNGTranscoder/KEY_WIDTH *svg-render-width*)
(when *svg-render-height*
(.addTranscodingHint transcoder PNGTranscoder/KEY_HEIGHT *svg-render-height*))
(.transcode transcoder in out))
(.toByteArray os))) | |
Convert a string (from svg rendering) an svg document then return the bytes | (defn svg-string->bytes [s] (-> s parse-svg-string render-svg)) |
Clojure entrypoint to render a timeseries or categorical waterfall chart. Rows should be tuples of [datetime numeric-value]. Labels is a map of {:left "left-label" :botton "bottom-label". Returns a byte array of a png file. | (defn waterfall
[rows labels settings waterfall-type]
(let [svg-string (.asString (js/execute-fn-name (context) "waterfall" rows
(map (fn [[k v]] [(name k) v]) labels)
(json/generate-string settings)
(name waterfall-type)
(json/generate-string (public-settings/application-colors))))]
(svg-string->bytes svg-string))) |
Clojure entrypoint to render a funnel chart. Data should be vec of [[Step Measure]] where Step is {:name name :format format-options} and Measure is {:format format-options} and you go and look to frontend/src/metabase/static-viz/components/FunnelChart/types.ts for the actual format options. Returns a byte array of a png file. | (defn funnel
[data settings]
(let [svg-string (.asString (js/execute-fn-name (context) "funnel" (json/generate-string data)
(json/generate-string settings)))]
(svg-string->bytes svg-string))) |
Clojure entrypoint to render javascript visualizations. | (defn javascript-visualization
[cards-with-data dashcard-viz-settings]
(let [response (.asString (js/execute-fn-name (context) "javascript_visualization"
(json/generate-string cards-with-data)
(json/generate-string dashcard-viz-settings)
(json/generate-string (public-settings/application-colors))))]
(-> response
(json/parse-string true)
(update :type (fnil keyword "unknown"))))) |
Clojure entrypoint to render a combo or multiple chart. These are different conceptions in the BE but being smushed together because they're supposed to display similarly. Series should be list of dicts of {rows: rows, cols: cols, type: type}, where types is 'line' or 'bar' or 'area'. Rows should be tuples of [datetime numeric-value]. Labels is a map of {:left "left-label" :botton "bottom-label"}. Returns a byte array of a png file. | (defn combo-chart
[series-seqs settings]
(svg-string->bytes
(.asString (js/execute-fn-name (context)
"combo_chart"
(json/generate-string series-seqs)
(json/generate-string settings)
(json/generate-string (public-settings/application-colors)))))) |
Clojure entrypoint to render a row chart. | (defn row-chart
[settings data]
(let [svg-string (.asString (js/execute-fn-name (context) "row_chart"
(json/generate-string settings)
(json/generate-string data)
(json/generate-string (public-settings/application-colors))))]
(svg-string->bytes svg-string))) |
Clojure entrypoint to render a categorical donut chart. Rows should be tuples of [category numeric-value]. Returns a byte array of a png file | (defn categorical-donut
[rows legend-colors settings]
(let [svg-string (.asString (js/execute-fn-name (context) "categorical_donut" rows (seq legend-colors) (json/generate-string settings)))]
(svg-string->bytes svg-string))) |
Clojure entrypoint to render a gauge chart. Returns a byte array of a png file | (defn gauge
[card data]
(let [js-res (js/execute-fn-name (context) "gauge"
(json/generate-string card)
(json/generate-string data))
svg-string (.asString js-res)]
(svg-string->bytes svg-string))) |
Clojure entrypoint to render a progress bar. Returns a byte array of a png file | (defn progress
[value goal settings]
(let [js-res (js/execute-fn-name (context) "progress"
(json/generate-string {:value value :goal goal})
(json/generate-string settings)
(json/generate-string (public-settings/application-colors)))
svg-string (.asString js-res)]
(svg-string->bytes svg-string))) |
(def ^:private icon-paths
{:dashboard "M32 28a4 4 0 0 1-4 4H4a4.002 4.002 0 0 1-3.874-3H0V4a4 4 0 0 1 4-4h25a3 3 0 0 1 3 3v25zm-4 0V8H4v20h24zM7.273 18.91h10.182v4.363H7.273v-4.364zm0-6.82h17.454v4.365H7.273V12.09zm13.09 6.82h4.364v4.363h-4.363v-4.364z"
:bell "M14.254 5.105c-7.422.874-8.136 7.388-8.136 11.12 0 4.007 0 5.61-.824 6.411-.549.535-1.647.802-3.294.802v4.006h28v-4.006c-1.647 0-2.47 0-3.294-.802-.55-.534-.824-3.205-.824-8.013-.493-5.763-3.205-8.936-8.136-9.518a2.365 2.365 0 0 0 .725-1.701C18.47 2.076 17.364 1 16 1s-2.47 1.076-2.47 2.404c0 .664.276 1.266.724 1.7zM11.849 29c.383 1.556 1.793 2.333 4.229 2.333s3.845-.777 4.229-2.333h-8.458z"}) | |
(defn- icon-svg-string [icon-name color] (str "<svg><path d=\ (get icon-paths icon-name) "\" fill=\ color "\"/></svg>")) | |
Entrypoint for rendering an SVG icon as a PNG, with a specific color | (defn icon
[icon-name color]
(let [svg-string (icon-svg-string icon-name color)]
(binding [*svg-render-width* (float 33)
*svg-render-height* (float 33)]
(svg-string->bytes svg-string)))) |
Logic for rendering HTML to a PNG. Ported by @tlrobinson from https://github.com/radkovo/CSSBox/blob/cssbox-4.10/src/main/java/org/fit/cssbox/demo/ImageRenderer.java with subsequent code simplification and cleanup by @camsaul CSSBox JavaDoc is here: http://cssbox.sourceforge.net/api/index.html | (ns metabase.pulse.render.png (:require [hiccup.core :refer [html]] [metabase.formatter :as formatter] [metabase.pulse.render.style :as style] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [schema.core :as s]) (:import (cz.vutbr.web.css MediaSpec) (java.awt Graphics2D RenderingHints) (java.awt.image BufferedImage) (java.io ByteArrayInputStream ByteArrayOutputStream) (java.nio.charset StandardCharsets) (javax.imageio ImageIO) (org.fit.cssbox.awt GraphicsEngine) (org.fit.cssbox.css CSSNorm DOMAnalyzer DOMAnalyzer$Origin) (org.fit.cssbox.io DefaultDOMSource StreamDocumentSource) (org.fit.cssbox.layout Dimension) (org.w3c.dom Document))) |
(set! *warn-on-reflection* true) | |
(defn- write-image! [^BufferedImage image, ^String format-name, ^ByteArrayOutputStream output-stream] (ImageIO/write image format-name output-stream)) | |
(defn- dom-analyzer
^DOMAnalyzer [^Document doc, ^StreamDocumentSource doc-source, ^Dimension window-size]
(doto (DOMAnalyzer. doc (.getURL doc-source))
(.setMediaSpec (doto (MediaSpec. "screen")
(.setDimensions (.width window-size) (.height window-size))
(.setDeviceDimensions (.width window-size) (.height window-size))))
.attributesToStyles
(.addStyleSheet nil (CSSNorm/stdStyleSheet) DOMAnalyzer$Origin/AGENT)
(.addStyleSheet nil (CSSNorm/userStyleSheet) DOMAnalyzer$Origin/AGENT)
(.addStyleSheet nil (CSSNorm/formsStyleSheet) DOMAnalyzer$Origin/AGENT)
.getStyleSheets)) | |
(defn- render-to-png
^java.awt.image.BufferedImage [^String html width]
(style/register-fonts-if-needed!)
(with-open [is (ByteArrayInputStream. (.getBytes html StandardCharsets/UTF_8))
doc-source (StreamDocumentSource. is nil "text/html; charset=utf-8")]
(let [dimension (Dimension. width 1)
doc (.parse (DefaultDOMSource. doc-source))
da (dom-analyzer doc doc-source dimension)
graphics-engine (proxy [GraphicsEngine] [(.getRoot da) da (.getURL doc-source)]
(setupGraphics [^Graphics2D g]
(doto g
(.setRenderingHint RenderingHints/KEY_RENDERING
RenderingHints/VALUE_RENDER_QUALITY)
(.setRenderingHint RenderingHints/KEY_ALPHA_INTERPOLATION
RenderingHints/VALUE_ALPHA_INTERPOLATION_QUALITY)
(.setRenderingHint RenderingHints/KEY_TEXT_ANTIALIASING
RenderingHints/VALUE_TEXT_ANTIALIAS_GASP)
(.setRenderingHint RenderingHints/KEY_FRACTIONALMETRICS
RenderingHints/VALUE_FRACTIONALMETRICS_ON))))]
(.createLayout graphics-engine dimension)
(let [image (.getImage graphics-engine)
viewport (.getViewport graphics-engine)
;; CSSBox voodoo -- sometimes maximal width < minimal width, no idea why
content-width (max (int (.getMinimalWidth viewport))
(int (.getMaximalWidth viewport)))]
;; Crop the image to the actual size of the rendered content so that tables don't have a ton of whitespace.
(if (< content-width (.getWidth image))
(.getSubimage image 0 0 content-width (.getHeight image))
image))))) | |
(s/defn render-html-to-png :- bytes
"Render the Hiccup HTML `content` of a Pulse to a PNG image, returning a byte array."
[{:keys [content]} :- formatter/RenderedPulseCard
width]
(try
(let [html (html [:html [:body {:style (style/style
{:margin 0
:padding 0
:background-color :white})}
content]])]
(with-open [os (ByteArrayOutputStream.)]
(-> (render-to-png html width)
(write-image! "png" os))
(.toByteArray os)))
(catch Throwable e
(log/error e (trs "Error rendering Pulse"))
(throw e)))) | |
CSS styles and related helper code for Pulse rendering. | (ns metabase.pulse.render.style (:require [clojure.java.io :as io] [clojure.string :as str] [metabase.public-settings :as public-settings] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log])) |
(set! *warn-on-reflection* true) | |
TODO - we should move other CSS definitions from | |
Compile one or more CSS style maps into a string. (style {:font-weight 400, :color "white"}) -> "font-weight: 400; color: white;" | (defn style
[& style-maps]
(str/join " " (for [[k v] (into {} style-maps)
:let [v (if (keyword? v) (name v) (str v))]
:when (seq v)]
(str (name k) ": " v ";")))) |
Used as color for 'We were unable to display this Pulse' messages. | (def ^:const color-gold "#F9D45C") |
Color for error messages. | (def ^:const color-error "#EF8C8C") |
~75% gray. | (def ^:const color-gray-2 "#BDC1BF") |
~50% gray. | (def ^:const color-gray-3 "#7C8381") |
~25% gray. | (def ^:const color-gray-4 "#394340") |
Color for light text. | (def ^:const color-text-light "#B8BBC3") |
Color for medium text. | (def ^:const color-text-medium "#949AAB") |
Color for dark text. | (def ^:const color-text-dark "#4C5773") |
Used as color for the border of table, table header, and table body rows for charts with | (def ^:const color-border "#F0F0F0") |
Primary color to use in Pulses; normally 'classic' MB blue, but customizable when whitelabeling is enabled. don't try to improve the code and make this a plain variable, in EE it's customizable which is why it's a function. Too much of a hassle to have it be a fn in one version of the code an a constant in another | (defn primary-color [] (public-settings/application-color)) |
Secondary color to use in Pulse charts; normally red, but customizable when whitelabeling is enabled. | (defn secondary-color [] (public-settings/secondary-chart-color)) |
Font family to use in rendered Pulses. | (defn font-style
[]
{:font-family "Lato, \"Helvetica Neue\", Helvetica, Arial, sans-serif"}) |
CSS style for a Pulse section. | (defn section-style [] (font-style)) |
Style for a header of a pulse section. | (defn header-style
[]
(merge
(font-style)
{:font-size :18px
:font-weight 700
:color (primary-color)
:text-decoration :none})) |
Style for a scalar display-type 'chart' in a Pulse. | (defn scalar-style
[]
(merge
(font-style)
{:font-size :24px
:font-weight 700
:color color-text-dark})) |
(defn- register-font! [filename]
(with-open [is (io/input-stream (io/resource filename))]
(.registerFont (java.awt.GraphicsEnvironment/getLocalGraphicsEnvironment)
(java.awt.Font/createFont java.awt.Font/TRUETYPE_FONT is)))) | |
(defn- register-fonts! []
(try
(doseq [weight ["regular" "700" "900"]]
(register-font! (format "frontend_client/app/fonts/Lato/lato-v16-latin-%s.ttf" weight)))
(catch Throwable e
(let [message (str (trs "Error registering fonts: Metabase will not be able to send Pulses.")
" "
(trs "This is a known issue with certain JVMs. See {0} and for more details."
"https://github.com/metabase/metabase/issues/7986"))]
(log/error e message)
(throw (ex-info message {} e)))))) | |
Makes custom fonts available to Java so that CSSBox can render them. | (defonce ^{:doc
:arglists '([])} register-fonts-if-needed!
(let [register!* (delay (register-fonts!))]
(fn []
@register!*))) |
(ns metabase.pulse.render.table (:require [clojure.string :as str] [hiccup.core :refer [h]] [medley.core :as m] [metabase.formatter] [metabase.pulse.render.color :as color] [metabase.pulse.render.style :as style]) (:import (metabase.formatter NumericWrapper))) | |
(comment metabase.formatter/keep-me) | |
(defn- bar-th-style []
(merge
(style/font-style)
{:font-size :12px
:font-weight 700
:color style/color-text-dark
:border-bottom (str "2px solid " style/color-border)
:border-right 0})) | |
(def ^:private max-bar-width 106) | |
(defn- bar-td-style []
(merge
(style/font-style)
{:font-size :12px
:font-weight 400
:text-align :left
:color style/color-text-dark
:border-bottom (str "1px solid " style/color-border)
:border-right (str "1px solid " style/color-border)
:padding "0.75em 1em"})) | |
(defn- bar-th-style-numeric []
(merge (style/font-style) (bar-th-style) {:text-align :right})) | |
(defn- bar-td-style-numeric []
(merge (style/font-style) (bar-td-style) {:text-align :right})) | |
(defn- render-bar-component
([color positive? width-in-pixels]
(render-bar-component color positive? width-in-pixels 0))
([color positive? width-in-pixels _offset]
[:div
{:style (style/style
(merge
{:width (format "%spx" width-in-pixels)
:background-color color
:max-height :10px
:height :10px
:margin-top :3px}
(if positive?
{:border-radius "0px 2px 2px 0px"}
{:border-radius "2px 0px 0px 2px"
;; `float: right` would be nice instead of the `margin-left` hack, but CSSBox puts in an erroneous 2px gap with it
:margin-left (format "%spx" (- max-bar-width width-in-pixels))})))}
" "])) | |
(defn- heading-style-for-type
[cell]
(if (instance? NumericWrapper cell)
(bar-th-style-numeric)
(bar-th-style))) | |
(defn- row-style-for-type
[cell]
(if (instance? NumericWrapper cell)
(bar-td-style-numeric)
(bar-td-style))) | |
(defn- normalized-score->pixels [score] (int (* (/ score 100.0) max-bar-width))) | |
(def ^:private max-column-character-length 16) | |
(defn- truncate-text [text]
(if (> (count text) max-column-character-length)
(str (str/trim (subs text 0 max-column-character-length)) "...")
text)) | |
(defn- render-table-head [{:keys [bar-width row]}]
[:thead
(conj (into [:tr]
(for [header-cell row]
[:th {:style (style/style (row-style-for-type header-cell) (heading-style-for-type header-cell) {:min-width :42px}) :title header-cell}
(truncate-text (h header-cell))]))
(when bar-width
[:th {:style (style/style (bar-td-style) (bar-th-style) {:width (str bar-width "%")})}]))]) | |
(defn- render-bar
[bar-width normalized-zero]
(if (< bar-width normalized-zero)
(list
[:td {:style (style/style (bar-td-style) {:width :99%, :border-right "1px solid black", :padding-right 0})}
(render-bar-component (style/secondary-color)
false
(normalized-score->pixels (- normalized-zero bar-width))
(normalized-score->pixels bar-width))]
[:td {:style (style/style (bar-td-style) {:width :99%})}])
(list
(when-not (zero? normalized-zero)
[:td {:style (style/style (bar-td-style) {:width :99%, :border-right "1px solid black"})}])
[:td {:style (style/style (bar-td-style) {:width :99%, :padding-left 0})}
(render-bar-component (style/primary-color)
true
(normalized-score->pixels (- bar-width normalized-zero)))]))) | |
Render Hiccup
(get-background-color cell-value column-name row-index) | (defn- render-table-body
[get-background-color normalized-zero column-names rows]
[:tbody
(for [[row-idx {:keys [row bar-width]}] (m/indexed rows)]
[:tr {:style (style/style {:color style/color-gray-3})}
(for [[col-idx cell] (m/indexed row)]
[:td {:style (style/style
(row-style-for-type cell)
{:background-color (get-background-color cell (get column-names col-idx) row-idx)}
(when (and bar-width (= col-idx 1))
{:font-weight 700})
(when (= row-idx (dec (count rows)))
{:border-bottom 0})
(when (= col-idx (dec (count row)))
{:border-right 0}))}
(h cell)])
(some-> bar-width (render-bar normalized-zero))])]) |
This function returns the HTML data structure for the pulse table. | (defn render-table
([color-selector column-names contents]
(render-table color-selector 0 column-names contents))
([color-selector normalized-zero column-names [header & rows]]
[:table {:style (style/style {:max-width "100%"
:white-space :nowrap
:border (str "1px solid " style/color-border)
:border-radius :6px
:width "1%"})
:cellpadding "0"
:cellspacing "0"}
(render-table-head header)
(render-table-body (partial color/get-background-color color-selector) normalized-zero column-names rows)])) |
Utils for pulses. | (ns metabase.pulse.util (:require [metabase.models.dashboard-card :as dashboard-card] [metabase.query-processor :as qp] [metabase.query-processor.middleware.permissions :as qp.perms] [metabase.server.middleware.session :as mw.session] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [toucan2.core :as t2])) |
Execute the query for a single Card. TODO - this should be done async | (defn execute-card
[{pulse-creator-id :creator_id} card-or-id & {:as options}]
;; The Card must either be executed in the context of a User
{:pre [(integer? pulse-creator-id)]}
(let [card-id (u/the-id card-or-id)]
(try
(when-let [{query :dataset_query
:keys [dataset result_metadata]
:as card} (t2/select-one :model/Card :id card-id, :archived false)]
(let [query (assoc query :async? false)
process-query (fn []
(binding [qp.perms/*card-id* card-id]
(qp/process-query-and-save-with-max-results-constraints!
(assoc query :middleware {:skip-results-metadata? true
:process-viz-settings? true
:js-int-to-string? false})
(merge (cond->
{:executed-by pulse-creator-id
:context :pulse
:card-id card-id}
dataset
(assoc :metadata/dataset-metadata result_metadata))
options))))
result (if pulse-creator-id
(mw.session/with-current-user pulse-creator-id
(process-query))
(process-query))]
{:card card
:result result}))
(catch Throwable e
(log/warn e (trs "Error running query for Card {0}" card-id)))))) |
Multi series card is composed of multiple cards, all of which need to be executed. This is as opposed to combo cards and cards with visualizations with multiple series, which are viz settings. | (defn execute-multi-card
[card-or-id dashcard-or-id]
(let [card-id (u/the-id card-or-id)
dashcard-id (u/the-id dashcard-or-id)
card (t2/select-one :model/Card :id card-id, :archived false)
dashcard (t2/select-one :model/DashboardCard :id dashcard-id)
multi-cards (dashboard-card/dashcard->multi-cards dashcard)]
(for [multi-card multi-cards]
(execute-card {:creator_id (:creator_id card)} (:id multi-card))))) |
Primary entrypoints to running Metabase (MBQL) queries. (metabase.query-processor/process-query {:type :query, :database 1, :query {:source-table 2}}) Various REST API endpoints, such as | (ns metabase.query-processor
(:refer-clojure :exclude [compile])
(:require
[metabase.config :as config]
[metabase.driver :as driver]
[metabase.driver.util :as driver.u]
[metabase.mbql.util :as mbql.u]
[metabase.plugins.classloader :as classloader]
[metabase.query-processor.context.default :as qp.context.default]
[metabase.query-processor.error-type :as qp.error-type]
[metabase.query-processor.middleware.add-default-temporal-unit
:as qp.add-default-temporal-unit]
[metabase.query-processor.middleware.add-dimension-projections
:as qp.add-dimension-projections]
[metabase.query-processor.middleware.add-implicit-clauses
:as qp.add-implicit-clauses]
[metabase.query-processor.middleware.add-implicit-joins
:as qp.add-implicit-joins]
[metabase.query-processor.middleware.add-rows-truncated
:as qp.add-rows-truncated]
[metabase.query-processor.middleware.add-source-metadata
:as qp.add-source-metadata]
[metabase.query-processor.middleware.add-timezone-info
:as qp.add-timezone-info]
[metabase.query-processor.middleware.annotate :as annotate]
[metabase.query-processor.middleware.auto-bucket-datetimes
:as qp.auto-bucket-datetimes]
[metabase.query-processor.middleware.auto-parse-filter-values
:as auto-parse-filter-values]
[metabase.query-processor.middleware.binning :as binning]
[metabase.query-processor.middleware.cache :as cache]
[metabase.query-processor.middleware.catch-exceptions
:as catch-exceptions]
[metabase.query-processor.middleware.check-features :as check-features]
[metabase.query-processor.middleware.constraints :as qp.constraints]
[metabase.query-processor.middleware.cumulative-aggregations
:as qp.cumulative-aggregations]
[metabase.query-processor.middleware.desugar :as desugar]
[metabase.query-processor.middleware.enterprise
:as qp.middleware.enterprise]
[metabase.query-processor.middleware.escape-join-aliases
:as escape-join-aliases]
[metabase.query-processor.middleware.expand-macros :as expand-macros]
[metabase.query-processor.middleware.fetch-source-query
:as fetch-source-query]
[metabase.query-processor.middleware.fix-bad-references
:as fix-bad-refs]
[metabase.query-processor.middleware.format-rows :as format-rows]
[metabase.query-processor.middleware.large-int-id :as large-int-id]
[metabase.query-processor.middleware.limit :as limit]
[metabase.query-processor.middleware.mbql-to-native :as mbql-to-native]
[metabase.query-processor.middleware.normalize-query :as normalize]
[metabase.query-processor.middleware.optimize-temporal-filters
:as optimize-temporal-filters]
[metabase.query-processor.middleware.parameters :as parameters]
[metabase.query-processor.middleware.permissions :as qp.perms]
[metabase.query-processor.middleware.persistence :as qp.persistence]
[metabase.query-processor.middleware.pre-alias-aggregations
:as qp.pre-alias-aggregations]
[metabase.query-processor.middleware.prevent-infinite-recursive-preprocesses
:as prevent-infinite-recursive-preprocesses]
[metabase.query-processor.middleware.process-userland-query
:as process-userland-query]
[metabase.query-processor.middleware.reconcile-breakout-and-order-by-bucketing
:as reconcile-bucketing]
[metabase.query-processor.middleware.resolve-database-and-driver
:as qp.resolve-database-and-driver]
[metabase.query-processor.middleware.resolve-fields
:as qp.resolve-fields]
[metabase.query-processor.middleware.resolve-joined-fields
:as resolve-joined-fields]
[metabase.query-processor.middleware.resolve-joins :as resolve-joins]
[metabase.query-processor.middleware.resolve-referenced
:as qp.resolve-referenced]
[metabase.query-processor.middleware.resolve-source-table
:as qp.resolve-source-table]
[metabase.query-processor.middleware.results-metadata
:as results-metadata]
[metabase.query-processor.middleware.splice-params-in-response
:as splice-params-in-response]
[metabase.query-processor.middleware.store :as store]
[metabase.query-processor.middleware.upgrade-field-literals
:as upgrade-field-literals]
[metabase.query-processor.middleware.validate :as validate]
[metabase.query-processor.middleware.validate-temporal-bucketing
:as validate-temporal-bucketing]
[metabase.query-processor.middleware.visualization-settings
:as viz-settings]
[metabase.query-processor.middleware.wrap-value-literals
:as qp.wrap-value-literals]
[metabase.query-processor.reducible :as qp.reducible]
[metabase.query-processor.store :as qp.store]
[metabase.util :as u]
[metabase.util.i18n :refer [tru]]
[metabase.util.malli :as mu])) |
+----------------------------------------------------------------------------------------------------------------+ | QUERY PROCESSOR | +----------------------------------------------------------------------------------------------------------------+ | |
This is a namespace that adds middleware to test MLv2 stuff every time we run a query. It lives in a Why not just do | (when config/tests-available? (classloader/require 'metabase.query-processor-test.test-mlv2)) |
Pre-processing middleware. Has the form (f query) -> query | (def ^:private pre-processing-middleware ;; ↓↓↓ PRE-PROCESSING ↓↓↓ happens from TOP TO BOTTOM [#'qp.perms/remove-permissions-key #'validate/validate-query #'expand-macros/expand-macros #'qp.resolve-referenced/resolve-referenced-card-resources #'parameters/substitute-parameters #'qp.resolve-source-table/resolve-source-tables #'qp.auto-bucket-datetimes/auto-bucket-datetimes #'reconcile-bucketing/reconcile-breakout-and-order-by-bucketing #'qp.add-source-metadata/add-source-metadata-for-source-queries #'upgrade-field-literals/upgrade-field-literals #'qp.middleware.enterprise/apply-sandboxing #'qp.persistence/substitute-persisted-query #'qp.add-implicit-clauses/add-implicit-clauses #'qp.add-dimension-projections/add-remapped-columns #'qp.resolve-fields/resolve-fields #'binning/update-binning-strategy #'desugar/desugar #'qp.add-default-temporal-unit/add-default-temporal-unit #'qp.add-implicit-joins/add-implicit-joins #'resolve-joins/resolve-joins #'resolve-joined-fields/resolve-joined-fields #'fix-bad-refs/fix-bad-references #'escape-join-aliases/escape-join-aliases ;; yes, this is called a second time, because we need to handle any joins that got added #'qp.middleware.enterprise/apply-sandboxing #'qp.cumulative-aggregations/rewrite-cumulative-aggregations #'qp.pre-alias-aggregations/pre-alias-aggregations #'qp.wrap-value-literals/wrap-value-literals #'auto-parse-filter-values/auto-parse-filter-values #'validate-temporal-bucketing/validate-temporal-bucketing #'optimize-temporal-filters/optimize-temporal-filters #'limit/add-default-limit #'qp.middleware.enterprise/apply-download-limit #'check-features/check-features]) |
All [[pre-processing-middleware]] combined into a single function. This still needs to be ran in the context of [[around-middleware]]. If you want to preprocess a query in isolation use [[preprocess]] below which combines this with the [[around-middleware]]. | (defn- preprocess*
[query]
(reduce
(fn [query middleware]
(u/prog1 (cond-> query
middleware middleware)
(assert (map? <>) (format "%s did not return a valid query" (pr-str middleware)))))
query
pre-processing-middleware)) |
Middleware for query compilation. Happens after pre-processing. Has the form (f (f query rff context)) -> (f query rff context) | (def ^:private compile-middleware [#'mbql-to-native/mbql->native]) |
Middleware that happens after compilation, AROUND query execution itself. Has the form (f qp) -> qp e.g. (f (f query rff context)) -> (f query rff context) | (def ^:private execution-middleware [#'cache/maybe-return-cached-results #'qp.perms/check-query-permissions #'qp.middleware.enterprise/check-download-permissions-middleware #'qp.middleware.enterprise/maybe-apply-column-level-perms-check-middleware]) |
Post-processing middleware that transforms results. Has the form (f preprocessed-query rff) -> rff Where (f metadata) -> rf | (def ^:private post-processing-middleware [#'results-metadata/record-and-return-metadata! (resolve 'metabase.query-processor-test.test-mlv2/post-processing-middleware) #'limit/limit-result-rows #'qp.middleware.enterprise/limit-download-result-rows #'qp.add-rows-truncated/add-rows-truncated #'splice-params-in-response/splice-params-in-response #'qp.add-timezone-info/add-timezone-info #'qp.middleware.enterprise/merge-sandboxing-metadata #'qp.add-dimension-projections/remap-results #'format-rows/format-rows #'large-int-id/convert-id-to-string #'viz-settings/update-viz-settings #'qp.cumulative-aggregations/sum-cumulative-aggregation-columns #'annotate/add-column-info]) |
↑↑↑ POST-PROCESSING ↑↑↑ happens from BOTTOM TO TOP | |
Apply post-processing middleware to | (defn apply-post-processing-middleware
[query rff]
(reduce
(fn [rff middleware]
(u/prog1 (cond->> rff
middleware (middleware query))
(assert (fn? <>) (format "%s did not return a valid function" (pr-str middleware)))))
rff
post-processing-middleware)) |
Middleware that goes AROUND all the other middleware (even for pre-processing only or compilation only). Has the form (f qp) -> qp Where (f query rff context) | (def around-middleware ;; think of the direction stuff happens in as if you were throwing a ball up in the air; as the query-ball goes up the ;; around middleware pre-processing stuff happens; then the query is executed, as the "ball of results" comes back ;; down any post-processing these around middlewares might do happens in reversed order. ;; ;; ↓↓↓ POST-PROCESSING ↓↓↓ happens from TOP TO BOTTOM [#'fetch-source-query/resolve-card-id-source-tables #'qp.resolve-database-and-driver/resolve-driver-and-database-local-values #'store/initialize-store #'qp.resolve-database-and-driver/resolve-database ;; `normalize` has to be done at the very beginning or `resolve-card-id-source-tables` and the like might not work. ;; It doesn't really need to be 'around' middleware tho. (resolve 'metabase.query-processor-test.test-mlv2/around-middleware) #'normalize/normalize #'qp.middleware.enterprise/handle-audit-app-internal-queries-middleware]) |
↑↑↑ PRE-PROCESSING ↑↑↑ happens from BOTTOM TO TOP | |
query -> preprocessed = around + pre-process query -> native = around + pre-process + compile query -> results = around + pre-process + compile + execute + post-process = default-middleware | |
The default set of middleware applied to queries ran via [[process-query]]. NOTE: if you add any new middleware groups, you may need to modify [[dev.debug-qp/default-debug-middleware]] as well, so that [[dev.debug-qp/process-query-debug]] still works as expected. | (def default-middleware
(letfn [(combined-pre-process [qp]
(fn combined-pre-process* [query rff context]
(qp (preprocess* query) rff context)))
(combined-post-process [qp]
(fn combined-post-process* [query rff context]
(qp query (apply-post-processing-middleware query rff) context)))]
(into
[]
(comp cat (keep identity))
[execution-middleware ; → → execute → → ↓
compile-middleware ; ↑ compile ↓
[combined-post-process] ; ↑ ↓ post-process
[combined-pre-process] ; ↑ pre-process ↓
around-middleware]))) ; ↑ query ↓ results |
In REPL-based dev rebuild the QP every time it is called; this way we don't need to reload this namespace when middleware is changed. Outside of dev only build the QP once for performance/locality | (defn- base-qp [middleware]
(letfn [(qp []
(qp.reducible/async-qp (qp.reducible/combine-middleware middleware)))]
(if config/is-dev?
(fn [& args]
(apply (qp) args))
(qp)))) |
Process a query asynchronously, returning a | (def ^{:arglists '([query] [query context] [query rff context])} process-query-async
(base-qp default-middleware)) |
Process a query synchronously, blocking until results are returned. Throws raised Exceptions directly. | (def ^{:arglists '([query] [query context] [query rff context])} process-query-sync
(qp.reducible/sync-qp process-query-async)) |
Process an MBQL query. This is the main entrypoint to the magical realm of the Query Processor. Returns a single
core.async channel if option | (mu/defn process-query
([query]
(process-query query nil))
([query context]
(process-query query nil context))
([{:keys [async?], :as query} :- :map
rff :- [:maybe fn?]
context :- [:maybe
[:and
:map
[:fn
{:error/message ":rff should no longer be included in context, pass it as a separate argument."}
(complement :rff)]]]]
(let [rff (or rff qp.reducible/default-rff)
context (or context (qp.context.default/default-context))]
((if async? process-query-async process-query-sync) query rff context)))) |
Return the fully preprocessed form for | (defn preprocess
[query]
(let [qp (qp.reducible/combine-middleware
(conj (vec around-middleware)
prevent-infinite-recursive-preprocesses/prevent-infinite-recursive-preprocesses)
(fn [query _rff _context]
(preprocess* query)))]
(qp query nil nil))) |
(defn- restore-join-aliases [preprocessed-query]
(let [replacement (-> preprocessed-query :info :alias/escaped->original)]
(escape-join-aliases/restore-aliases preprocessed-query replacement))) | |
Return the | (defn query->expected-cols
[{query-type :type, :as query}]
(when-not (= (mbql.u/normalize-token query-type) :query)
(throw (ex-info (tru "Can only determine expected columns for MBQL queries.")
{:type qp.error-type/qp})))
;; TODO - we should throw an Exception if the query has a native source query or at least warn about it. Need to
;; check where this is used.
(qp.store/with-metadata-provider (qp.resolve-database-and-driver/resolve-database-id query)
(let [preprocessed (-> query preprocess restore-join-aliases)]
(driver/with-driver (driver.u/database->driver (:database preprocessed))
(->> (annotate/merged-column-info preprocessed nil)
;; remove MLv2 columns so we don't break a million tests. Once the whole QP is updated to use MLv2 metadata
;; directly we can stop stripping these out
(mapv (fn [col]
(dissoc col :lib/external_remap :lib/internal_remap)))
not-empty))))) |
Return the native form for | (defn compile
[query]
(let [qp (qp.reducible/combine-middleware
(conj (vec around-middleware)
prevent-infinite-recursive-preprocesses/prevent-infinite-recursive-preprocesses)
(fn [query _rff _context]
(mbql-to-native/query->native-form (preprocess* query))))]
(qp query nil nil))) |
Return the native form for a | (defn compile-and-splice-parameters
[query]
;; We need to preprocess the query first to get a valid database in case we're dealing with a nested query whose DB
;; ID is the virtual DB identifier
(let [driver (driver.u/database->driver (:database (preprocess query)))]
(driver/splice-parameters-into-native-query driver (compile query)))) |
+----------------------------------------------------------------------------------------------------------------+ | Userland Queries (Public Interface) | +----------------------------------------------------------------------------------------------------------------+ | |
The default set of middleware applied to 'userland' queries ran via [[process-query-and-save-execution!]] (i.e., via the REST API). This middleware has the pattern (f (f query rff context)) -> (f query rff context) The difference between | (def userland-middleware
(concat
default-middleware
[#'qp.constraints/add-default-userland-constraints
#'process-userland-query/process-userland-query
#'catch-exceptions/catch-exceptions])) |
Like [[process-query-async]], but for 'userland' queries (e.g., queries ran via the REST API). Adds extra middleware. | (def ^{:arglists '([query] [query context] [query rff context])} ^:private process-userland-query-async
(base-qp userland-middleware)) |
Like [[process-query-sync]], but for 'userland' queries (e.g., queries ran via the REST API). Adds extra middleware. | (def ^{:arglists '([query] [query context] [query rff context])} process-userland-query-sync
(qp.reducible/sync-qp process-userland-query-async)) |
Like [[process-query]], but for 'userland' queries (e.g., queries ran via the REST API). Adds extra middleware. | (defn process-userland-query
{:arglists '([query] [query context] [query rff context])}
[{:keys [async?], :as query} & args]
(apply (if async? process-userland-query-async process-userland-query-sync)
query
args)) |
Process and run a 'userland' MBQL query (e.g. one ran as the result of an API call, scheduled Pulse, etc). Returns results in a format appropriate for consumption by FE client. Saves QueryExecution row in application DB. | (defn process-query-and-save-execution! ([query info] (process-userland-query (assoc query :info info))) ([query info context] (process-userland-query (assoc query :info info) context)) ([query info rff context] (process-userland-query (assoc query :info info) rff context))) |
(defn- add-default-constraints [query] (assoc-in query [:middleware :add-default-userland-constraints?] true)) | |
Same as [[process-query-and-save-execution!]] but will include the default max rows returned as a constraint. (This
function is ulitmately what powers most API endpoints that run queries, including | (defn process-query-and-save-with-max-results-constraints! ([query info] (process-query-and-save-execution! (add-default-constraints query) info)) ([query info context] (process-query-and-save-execution! (add-default-constraints query) info context)) ([query info rff context] (process-query-and-save-execution! (add-default-constraints query) info rff context))) |
Mostly legacy namespace that these days is reduced to a single util function, | (ns metabase.query-processor.async (:require [clojure.core.async :as a] [metabase.api.common :as api] [metabase.query-processor :as qp] [metabase.query-processor.context :as qp.context] [metabase.query-processor.interface :as qp.i] [metabase.query-processor.util :as qp.util] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [schema.core :as s]) (:import (clojure.core.async.impl.channels ManyToManyChannel))) |
(defn- query-for-result-metadata [query]
;; for purposes of calculating the actual Fields & types returned by this query we really only need the first
;; row in the results
(let [query (-> query
(assoc-in [:constraints :max-results] 1)
(assoc-in [:constraints :max-results-bare-rows] 1)
(assoc-in [:info :executed-by] api/*current-user-id*))]
;; need add the constraints above before calculating hash because those affect the hash
;;
;; (normally middleware takes care of calculating query hashes for 'userland' queries but this is not
;; technically a userland query -- we don't want to save a QueryExecution -- so we need to add `executed-by`
;; and `query-hash` ourselves so the remark gets added)
(assoc-in query [:info :query-hash] (qp.util/query-hash query)))) | |
(defn- async-result-metadata-reducedf [result context]
(let [results-metdata (or (get-in result [:data :results_metadata :columns])
[])]
(qp.context/resultf results-metdata context))) | |
(defn- async-result-metdata-raisef [e context] (log/error e (trs "Error running query to determine Card result metadata:")) (qp.context/resultf [] context)) | |
(s/defn result-metadata-for-query-async :- ManyToManyChannel
"Fetch the results metadata for a `query` by running the query and seeing what the QP gives us in return.
This is obviously a bit wasteful so hopefully we can avoid having to do this. Returns a channel to get the
results."
[query]
(binding [qp.i/*disable-qp-logging* true]
;; for MBQL queries we can infer the columns just by preprocessing the query.
(if-let [inferred-columns (not-empty (u/ignore-exceptions (qp/query->expected-cols query)))]
(let [chan (a/promise-chan)]
(a/>!! chan inferred-columns)
(a/close! chan)
chan)
;; for *native* queries we actually have to run it.
(let [query (query-for-result-metadata query)]
(qp/process-query-async query {:reducedf async-result-metadata-reducedf
:raisef async-result-metdata-raisef}))))) | |
Code for running a query in the context of a specific Card. | (ns metabase.query-processor.card
(:require
[clojure.string :as str]
[medley.core :as m]
[metabase.api.common :as api]
[metabase.lib.schema.template-tag :as lib.schema.template-tag]
[metabase.mbql.normalize :as mbql.normalize]
[metabase.mbql.schema :as mbql.s]
[metabase.mbql.util :as mbql.u]
[metabase.models.card :as card :refer [Card]]
[metabase.models.dashboard :refer [Dashboard]]
[metabase.models.database :refer [Database]]
[metabase.models.query :as query]
[metabase.public-settings :as public-settings]
[metabase.public-settings.premium-features
:as premium-features
:refer [defenterprise]]
[metabase.query-processor :as qp]
[metabase.query-processor.error-type :as qp.error-type]
[metabase.query-processor.middleware.constraints :as qp.constraints]
[metabase.query-processor.middleware.permissions :as qp.perms]
[metabase.query-processor.streaming :as qp.streaming]
[metabase.query-processor.util :as qp.util]
[metabase.util :as u]
[metabase.util.i18n :refer [trs tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
#_{:clj-kondo/ignore [:discouraged-namespace]}
[toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
Compute a 'magic' cache TTL time (in seconds) for | (defn- query-magic-ttl
[query]
(when-let [average-duration (query/average-execution-time-ms (qp.util/query-hash query))]
(let [ttl-seconds (Math/round (float (/ (* average-duration (public-settings/query-caching-ttl-ratio))
1000.0)))]
(when-not (zero? ttl-seconds)
(log/info (trs "Question''s average execution duration is {0}; using ''magic'' TTL of {1}"
(u/format-milliseconds average-duration) (u/format-seconds ttl-seconds))
(u/emoji "💾"))
ttl-seconds)))) |
Returns the granular cache ttl (in seconds) for a card. On EE, this first checking whether there is a stored value for the card, dashboard, or database (in that order of decreasing preference). Returns nil on OSS. | (defenterprise granular-ttl metabase-enterprise.advanced-config.caching [_card _dashboard _database]) |
Returns the cache ttl (in seconds), by first checking whether there is a stored value for the database,
dashboard, or card (in that order of increasing preference), and if all of those don't exist, then the
| (defn- ttl-hierarchy
[card dashboard database query]
(when (public-settings/enable-query-caching)
(or (granular-ttl card dashboard database)
(query-magic-ttl query)))) |
Generate a query for a saved Card | (defn query-for-card
[{query :dataset_query
:as card} parameters constraints middleware & [ids]]
(let [query (-> query
;; don't want default constraints overridding anything that's already there
(m/dissoc-in [:middleware :add-default-userland-constraints?])
(assoc :constraints constraints
:parameters parameters
:middleware middleware))
dashboard (t2/select-one [Dashboard :cache_ttl] :id (:dashboard-id ids))
database (t2/select-one [Database :cache_ttl] :id (:database_id card))
ttl-secs (ttl-hierarchy card dashboard database query)]
(assoc query :cache-ttl ttl-secs))) |
In 0.41.0+ you can no longer add arbitrary Normally, when running a query in the context of a /Card/, this is | (def ^:dynamic *allow-arbitrary-mbql-parameters* false) |
Template tag parameters that have been specified for the query for Card with {"templatetagparameter_name" :parameter-type, ...} Template tag parameter name is the name of the parameter as it appears in the query, e.g. Parameter type in this case is something like | (defn- card-template-tag-parameters
[card-id]
(let [query (api/check-404 (t2/select-one-fn :dataset_query Card :id card-id))]
(into
{}
(comp
(map (fn [[param-name {widget-type :widget-type, tag-type :type}]]
;; Field Filter parameters have a `:type` of `:dimension` and the widget type that should be used is
;; specified by `:widget-type`. Non-Field-filter parameters just have `:type`. So prefer
;; `:widget-type` if available but fall back to `:type` if not.
(cond
(and (= tag-type :dimension)
(not= widget-type :none))
[param-name widget-type]
(contains? mbql.s/raw-value-template-tag-types tag-type)
[param-name tag-type])))
(filter some?))
(get-in query [:native :template-tags])))) |
(defn- allowed-parameter-type-for-template-tag-widget-type? [parameter-type widget-type]
(when-let [allowed-template-tag-types (get-in mbql.s/parameter-types [parameter-type :allowed-for])]
(contains? allowed-template-tag-types widget-type))) | |
(defn- allowed-parameter-types-for-template-tag-widget-type [widget-type]
(into #{} (for [[parameter-type {:keys [allowed-for]}] mbql.s/parameter-types
:when (contains? allowed-for widget-type)]
parameter-type))) | |
If a parameter (i.e., a template tag or Dashboard parameter) is specified with
Background: some more-specific parameter types aren't allowed for certain types of parameters. See [[metabase.mbql.schema/parameter-types]] for details. | (mu/defn check-allowed-parameter-value-type
[parameter-name
widget-type :- ::lib.schema.template-tag/widget-type
parameter-value-type :- ::mbql.s/ParameterType]
(when-not (allowed-parameter-type-for-template-tag-widget-type? parameter-value-type widget-type)
(let [allowed-types (allowed-parameter-types-for-template-tag-widget-type widget-type)]
(throw (ex-info (tru "Invalid parameter type {0} for parameter {1}. Parameter type must be one of: {2}"
parameter-value-type
(pr-str parameter-name)
(str/join ", " (sort allowed-types)))
{:type qp.error-type/invalid-parameter
:invalid-parameter parameter-name
:template-tag-type widget-type
:allowed-types allowed-types}))))) |
Attempt to infer the name of a parameter. Uses | (defn- infer-parameter-name
[{parameter-name :name, :keys [target]}]
(or
parameter-name
(mbql.u/match-one target
[:template-tag tag-name]
(name tag-name)))) |
Unless [[allow-arbitrary-mbql-parameters]] is truthy, check to make all supplied | (mu/defn ^:private validate-card-parameters
[card-id :- ms/PositiveInt
parameters :- mbql.s/ParameterList]
(when-not *allow-arbitrary-mbql-parameters*
(let [template-tags (card-template-tag-parameters card-id)]
(doseq [request-parameter parameters
:let [parameter-name (infer-parameter-name request-parameter)]]
(let [matching-widget-type (or (get template-tags parameter-name)
(throw (ex-info (tru "Invalid parameter: Card {0} does not have a template tag named {1}."
card-id
(pr-str parameter-name))
{:type qp.error-type/invalid-parameter
:invalid-parameter request-parameter
:allowed-parameters (keys template-tags)})))]
;; now make sure the type agrees as well
(check-allowed-parameter-value-type parameter-name matching-widget-type (:type request-parameter))))))) |
Run the query for Card with
| (defn run-query-for-card-async
[card-id export-format
& {:keys [parameters constraints context dashboard-id dashcard-id middleware qp-runner run ignore_cache]
:or {constraints (qp.constraints/default-query-constraints)
context :question
qp-runner qp/process-query-and-save-execution!}}]
{:pre [(int? card-id) (u/maybe? sequential? parameters)]}
(let [run (or run
;; param `run` can be used to control how the query is ran, e.g. if you need to
;; customize the `context` passed to the QP
(^:once fn* [query info]
(qp.streaming/streaming-response [{:keys [rff context]} export-format (u/slugify (:card-name info))]
(qp-runner query info rff context))))
dash-viz (when (not= context :question)
(t2/select-one-fn :visualization_settings :model/DashboardCard :id dashcard-id))
card (api/read-check (t2/select-one [Card :id :name :dataset_query :database_id :cache_ttl :collection_id
:dataset :result_metadata :visualization_settings]
:id card-id))
query (-> (query-for-card card parameters constraints middleware {:dashboard-id dashboard-id})
(update :viz-settings (fn [viz] (merge viz dash-viz)))
(assoc :async? true)
(update :middleware (fn [middleware]
(merge
{:js-int-to-string? true :ignore-cached-results? ignore_cache}
middleware))))
info (cond-> {:executed-by api/*current-user-id*
:context context
:card-id card-id
:card-name (:name card)
:dashboard-id dashboard-id
:visualization-settings (:visualization_settings card)}
(and (:dataset card) (seq (:result_metadata card)))
(assoc :metadata/dataset-metadata (:result_metadata card)))]
(api/check-not-archived card)
(when (seq parameters)
(validate-card-parameters card-id (mbql.normalize/normalize-fragment [:parameters] parameters)))
(log/tracef "Running query for Card %d:\n%s" card-id
(u/pprint-to-str query))
(binding [qp.perms/*card-id* card-id]
(run query info)))) |
Interface for the QP context/utility functions for using the things in the context correctly. The default implementations of all these functions live in [[metabase.query-processor.context.default]]; refer to those when overriding individual functions. Some wiring for the [[clojure.core.async]] channels takes place in [[metabase.query-processor.reducible]]. | (ns metabase.query-processor.context (:require [metabase.async.util :as async.u])) |
Raise an Exception. | (defn raisef
{:arglists '([e context])}
[e {raisef* :raisef, :as context}]
{:pre [(fn? raisef*)]}
(raisef* e context)) |
Called by the [[metabase.query-processor.reducible/identity-qp]] fn to run preprocessed query. Normally, this simply calls [[executef]], but you can override this for test purposes. The result of this function is ignored. Normal flow is something like: [middleware] → runf → executef → reducef → reducedf -\ ↓ ↦ resultf → out-chan [Exception] → raisef -------------------------------/ ↑ ↑ | timeoutf | ↑ | [time out] [out-chan closed early] | ↓ [closes] | canceled-chan --------------------------/ ↑ [message sent to canceled chan]
| (defn runf
{:arglists '([query rff context])}
[query rff {runf* :runf, :as context}]
{:pre [(fn? runf*)]}
(runf* query rff context)
nil) |
Called by [[runf]] to have driver run query. By default, [[metabase.driver/execute-reducible-query]]. (respond results-metadata reducible-rows) The implementation of [[executef]] should call | (defn executef
{:arglists '([driver query context respond])}
[driver query {executef* :executef, :as context} respond]
{:pre [(ifn? executef*)]}
(executef* driver query context respond)
nil) |
Called by [[runf]] (inside the | (defn reducef
{:arglists '([rff context metadata reducible-rows])}
[rff {reducef* :reducef, :as context} metadata reducible-rows]
{:pre [(fn? reducef*)]}
(reducef* rff context metadata reducible-rows)
nil) |
Called in [[reducedf]] with fully reduced results. This result is passed to [[resultf]]. | (defn reducedf
{:arglists '([reduced-rows context])}
[reduced-rows {reducedf* :reducedf, :as context}]
{:pre [(fn? reducedf*)]}
(reducedf* reduced-rows context)) |
Call this function when a query times out. | (defn timeoutf
{:arglists '([context])}
[{timeoutf* :timeoutf, :as context}]
{:pre [(fn? timeoutf*)]}
(timeoutf* context)) |
Called exactly once with the final result, which is the result of either [[reducedf]] or [[raisef]]. | (defn resultf
{:arglists '([result context])}
[result {resultf* :resultf, :as context}]
{:pre [(fn? resultf*)]}
(resultf* result context)) |
Maximum amount of time query is allowed to run, in ms. | (defn timeout
{:arglists '([context])}
[{timeout* :timeout}]
{:pre [(int? timeout*)]}
timeout*) |
Gets a message if query is canceled. | (defn canceled-chan
{:arglists '([context])}
[{canceled-chan* :canceled-chan}]
{:pre [(async.u/promise-chan? canceled-chan*)]}
canceled-chan*) |
Gets a message with the final result. | (defn out-chan
{:arglists '([context])}
[{out-chan* :out-chan}]
{:pre [(async.u/promise-chan? out-chan*)]}
out-chan*) |
(ns metabase.query-processor.context.default (:require [clojure.core.async :as a] [metabase.config :as config] [metabase.driver :as driver] [metabase.query-processor.context :as qp.context] [metabase.query-processor.error-type :as qp.error-type] [metabase.util :as u] [metabase.util.i18n :refer [trs tru]] [metabase.util.log :as log])) | |
Maximum amount of time to wait for a running query to complete before throwing an Exception. | (def query-timeout-ms
;; I don't know if these numbers make sense, but my thinking is we want to enable (somewhat) long-running queries on
;; prod but for test and dev purposes we want to fail faster because it usually means I broke something in the QP
;; code
(u/minutes->ms
(if config/is-prod?
20
3))) |
(defn- default-reducedf [reduced-result context] (qp.context/resultf reduced-result context)) | |
Default implementation of | (defn default-reducef
[rff context metadata reducible-rows]
{:pre [(fn? rff)]}
(let [rf (rff metadata)]
(assert (fn? rf))
(when-let [reduced-rows (try
(transduce identity rf reducible-rows)
(catch Throwable e
(qp.context/raisef (ex-info (tru "Error reducing result rows: {0}" (ex-message e))
{:type qp.error-type/qp}
e)
context)))]
(qp.context/reducedf reduced-rows context)))) |
(defn- default-runf [query rff context]
(try
(qp.context/executef driver/*driver* query context (fn respond* [metadata reducible-rows]
(qp.context/reducef rff context metadata reducible-rows)))
(catch Throwable e
(qp.context/raisef e context)))) | |
(defn- default-raisef [e context]
{:pre [(instance? Throwable e)]}
(qp.context/resultf e context)) | |
(defn- default-resultf [result context]
(if (nil? result)
(do
(log/error (ex-info (trs "Unexpected nil result") {}))
(recur false context))
(let [out-chan (qp.context/out-chan context)]
(a/>!! out-chan result)
(a/close! out-chan)))) | |
(defn- default-timeoutf
[context]
(let [timeout (qp.context/timeout context)]
(log/debug (trs "Query timed out after {0}, raising timeout exception." (u/format-milliseconds timeout)))
(qp.context/raisef (ex-info (tru "Timed out after {0}." (u/format-milliseconds timeout))
{:status :timed-out
:type qp.error-type/timed-out})
context))) | |
Return a new context for executing queries using the default values. These can be overrided as needed. | (defn default-context
[]
{::complete? true
:timeout query-timeout-ms
:raisef default-raisef
:runf default-runf
:executef driver/execute-reducible-query
:reducef default-reducef
:reducedf default-reducedf
:timeoutf default-timeoutf
:resultf default-resultf
:canceled-chan (a/promise-chan)
:out-chan (a/promise-chan)}) |
Code for running a query in the context of a specific DashboardCard. | (ns metabase.query-processor.dashboard
(:require
[clojure.string :as str]
[medley.core :as m]
[metabase.api.common :as api]
[metabase.driver.common.parameters.operators :as params.ops]
[metabase.mbql.normalize :as mbql.normalize]
[metabase.models.dashboard :as dashboard :refer [Dashboard]]
[metabase.models.dashboard-card :refer [DashboardCard]]
[metabase.models.dashboard-card-series :refer [DashboardCardSeries]]
[metabase.query-processor.card :as qp.card]
[metabase.query-processor.error-type :as qp.error-type]
[metabase.query-processor.middleware.constraints :as qp.constraints]
[metabase.util :as u]
[metabase.util.i18n :refer [tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[steffan-westcott.clj-otel.api.trace.span :as span]
#_{:clj-kondo/ignore [:discouraged-namespace]}
[toucan2.core :as t2])) |
Check that the Card with | (defn- check-card-and-dashcard-are-in-dashboard
[dashboard-id card-id dashcard-id]
(api/check-404
(or (t2/exists? DashboardCard
:id dashcard-id
:dashboard_id dashboard-id
:card_id card-id)
(and
(t2/exists? DashboardCard
:id dashcard-id
:dashboard_id dashboard-id)
(t2/exists? DashboardCardSeries
:card_id card-id
:dashboardcard_id dashcard-id))))) |
(defn- resolve-param-for-card
[card-id dashcard-id param-id->param {param-id :id, :as request-param}]
(when-not param-id
(throw (ex-info (tru "Unable to resolve invalid query parameter: parameter is missing :id")
{:type qp.error-type/invalid-parameter
:invalid-parameter request-param})))
(log/tracef "Resolving parameter %s\n%s" (pr-str param-id) (u/pprint-to-str request-param))
;; find information about this dashboard parameter by its parameter `:id`. If no parameter with this ID
;; exists, it is an error.
(let [matching-param (or (get param-id->param param-id)
(throw (ex-info (tru "Dashboard does not have a parameter with ID {0}." (pr-str param-id))
{:type qp.error-type/invalid-parameter
:status-code 400})))]
(log/tracef "Found matching Dashboard parameter\n%s" (u/pprint-to-str (update matching-param :mappings (fn [mappings]
(into #{} (map #(dissoc % :dashcard)) mappings)))))
;; now find the mapping for this specific card. If there is no mapping, we can just ignore this parameter.
(when-let [matching-mapping (or (some (fn [mapping]
(when (and (= (:card_id mapping) card-id)
(= (get-in mapping [:dashcard :id]) dashcard-id))
mapping))
(:mappings matching-param))
(log/tracef "Parameter has no mapping for Card %d; skipping" card-id))]
(log/tracef "Found matching mapping for Card %d, Dashcard %d:\n%s"
card-id dashcard-id
(u/pprint-to-str (update matching-mapping :dashcard #(select-keys % [:id :parameter_mappings]))))
;; if `request-param` specifies type, then validate that the type is allowed
(when (:type request-param)
(qp.card/check-allowed-parameter-value-type
param-id
(or (when (and (= (:type matching-param) :dimension)
(not= (:widget-type matching-param) :none))
(:widget-type matching-param))
(:type matching-param))
(:type request-param)))
;; ok, now return the merged parameter info map.
(merge
{:type (:type matching-param)}
request-param
;; if value comes in as a lone value for an operator filter type (as will be the case for embedding) wrap it in a
;; vector so the parameter handling code doesn't explode.
(let [value (:value request-param)]
(when (and (params.ops/operator? (:type matching-param))
(if (string? value)
(not (str/blank? value))
(some? value))
(not (sequential? value)))
{:value [value]}))
{:id param-id
:target (:target matching-mapping)})))) | |
DashboardCard parameter mappings can specify default values, and we need to make sure the parameters map returned by [[resolve-params-for-query]] includes entries for any default values. So we'll do this by creating a entries for all the parameters with defaults, and then merge together a map of param-id->default-entry with a map of param-id->request-entry (so the value from the request takes precedence over the default value) | |
Construct parameter entries for any parameters with default values in | (defn- dashboard-param-defaults
[dashboard-param-id->param card-id]
(into
{}
(comp (filter (fn [[_ {:keys [default]}]]
default))
(map (fn [[param-id {:keys [default mappings]}]]
[param-id {:id param-id
:default default
;; make sure we include target info so we can actually map this back to a template
;; tag/param declaration
:target (some (fn [{mapping-card-id :card_id, :keys [target]}]
(when (= mapping-card-id card-id)
target))
mappings)}]))
(filter (fn [[_ {:keys [target]}]]
target)))
dashboard-param-id->param)) |
(mu/defn ^:private resolve-params-for-query :- [:maybe [:sequential :map]]
"Given a sequence of parameters included in a query-processing request to run the query for a Dashboard/Card, validate
that those parameters exist and have allowed types, and merge in default values and other info from the parameter
mappings."
[dashboard-id :- ms/PositiveInt
card-id :- ms/PositiveInt
dashcard-id :- ms/PositiveInt
request-params :- [:maybe [:sequential :map]]]
(log/tracef "Resolving Dashboard %d Card %d query request parameters" dashboard-id card-id)
(let [request-params (mbql.normalize/normalize-fragment [:parameters] request-params)
;; ignore default values in request params as well. (#20516)
request-params (for [param request-params]
(dissoc param :default))
dashboard (api/check-404 (t2/select-one Dashboard :id dashboard-id))
dashboard-param-id->param (into {}
;; remove the `:default` values from Dashboard params. We don't ACTUALLY want to
;; use these values ourselves -- the expectation is that the frontend will pass
;; them in as an actual `:value` if it wants to use them. If we leave them
;; around things get confused and it prevents us from actually doing the
;; expected `1 = 1` substitution for Field filters. See comments in #20503 for
;; more information.
(map (fn [[param-id param]]
[param-id (dissoc param :default)]))
(dashboard/dashboard->resolved-params dashboard))
request-param-id->param (into {} (map (juxt :id identity)) request-params)
merged-parameters (vals (merge (dashboard-param-defaults dashboard-param-id->param card-id)
request-param-id->param))]
(log/tracef "Dashboard parameters:\n%s\nRequest parameters:\n%s\nMerged:\n%s"
(u/pprint-to-str (->> dashboard-param-id->param
(m/map-vals (fn [param]
(update param :mappings (fn [mappings]
(into #{} (map #(dissoc % :dashcard)) mappings)))))))
(u/pprint-to-str request-param-id->param)
(u/pprint-to-str merged-parameters))
(u/prog1
(into [] (comp (map (partial resolve-param-for-card card-id dashcard-id dashboard-param-id->param))
(filter some?))
merged-parameters)
(log/tracef "Resolved =>\n%s" (u/pprint-to-str <>))))) | |
Like [[metabase.query-processor.card/run-query-for-card-async]], but runs the query for a See [[metabase.query-processor.card/run-query-for-card-async]] for more information about the various parameters. | (defn run-query-for-dashcard-async
{:arglists '([& {:keys [dashboard-id card-id dashcard-id export-format parameters ignore_cache constraints parameters middleware]}])}
[& {:keys [dashboard-id card-id dashcard-id parameters export-format]
:or {export-format :api}
:as options}]
(span/with-span! {:name "run-query-for-dashcard-async"
:attributes {:dashboard/id dashboard-id
:dashcard/id dashcard-id
:card/id card-id}}
;; make sure we can read this Dashboard. Card will get read-checked later on inside
;; [[qp.card/run-query-for-card-async]]
(api/read-check Dashboard dashboard-id)
(check-card-and-dashcard-are-in-dashboard dashboard-id card-id dashcard-id)
(let [resolved-params (resolve-params-for-query dashboard-id card-id dashcard-id parameters)
options (merge
{:ignore_cache false
:constraints (qp.constraints/default-query-constraints)
:context :dashboard}
options
{:parameters resolved-params
:dashboard-id dashboard-id})]
(log/tracef "Running Query for Dashboard %d, Card %d, Dashcard %d with options\n%s"
dashboard-id card-id dashcard-id
(u/pprint-to-str options))
;; we've already validated our parameters, so we don't need the [[qp.card]] namespace to do it again
(binding [qp.card/*allow-arbitrary-mbql-parameters* true]
(m/mapply qp.card/run-query-for-card-async card-id export-format options))))) |
A hierarchy of all QP error types. Ideally all QP exceptions should be (throw (ex-info (tru "Don''t know how to parse {0} {1}" (class x) x) {:type qp.error-type/invalid-parameter})) | (ns metabase.query-processor.error-type) |
(def ^:private hierarchy (make-hierarchy)) | |
Is | (defn known-error-type? [error-type] (isa? hierarchy error-type :error)) |
Should errors of this type be shown to users of Metabase in embedded Cards or Dashboards? Normally, we return a generic 'Query Failed' error message for embedded queries, so as not to leak information. Some errors (like missing parameter errors), however, should be shown even in these situations. | (defn show-in-embeds? [error-type] (isa? hierarchy error-type :show-in-embeds?)) |
(defmacro ^:private deferror
{:style/indent 1}
[error-name docstring & {:keys [parent show-in-embeds?]}]
{:pre [(some? parent)]}
`(do
(def ~error-name ~docstring ~(keyword error-name))
(alter-var-root #'hierarchy derive ~(keyword error-name) ~(keyword parent))
~(when show-in-embeds?
`(alter-var-root #'hierarchy derive ~(keyword error-name) :show-in-embeds?)))) | |
Client Errors | |
Generic ancestor type for all errors with the query map itself. Equivalent of a HTTP 4xx status code. | (deferror client :parent :error) |
Is | (defn client-error? [error-type] (isa? hierarchy error-type :client)) |
The current user does not have required permissions to run the current query. | (deferror missing-required-permissions :parent client) |
Something related to configuration (e.g. of a sandbox/GTAP) is preventing us from being able to run the query. | (deferror bad-configuration :parent client) |
Generic ancestor type for errors with the query map itself. | (deferror invalid-query :parent client) |
The query is parameterized, and a required parameter was not supplied. | (deferror missing-required-parameter :parent invalid-query :show-in-embeds? true) |
The query is parameterized, and a supplied parameter has an invalid value. | (deferror invalid-parameter :parent invalid-query :show-in-embeds? true) |
The query is using a feature that is not supported by the database/driver. | (deferror unsupported-feature :parent invalid-query :show-in-embeds? true) |
Server-Side Errors | |
Generic ancestor type for all unexpected server-side errors. Equivalent of a HTTP 5xx status code. | (deferror server :parent :error) |
Error type if query fails to return the first row of results after some timeout. | (deferror timed-out :parent server :show-in-embeds? true) |
QP Errors | |
Generic ancestor type for all unexpected errors (e.g., uncaught Exceptions) in Query Processor code. | (deferror qp :parent server) |
Generic ancestor type for all unexpected errors related to bad drivers and uncaught Exceptions in driver code. | (deferror driver :parent qp) |
Data Warehouse (DB) Errors | |
Generic ancestor type for all unexpected errors returned or thrown by a data warehouse when running a query. | (deferror db :parent server) |
Dynamic variables, constants, and other things used across the query builder namespaces. | (ns metabase.query-processor.interface) |
TODO - Not 100% sure we really need this namespace since it's almost completely empty these days. Seems like the things here could be moved elsewhere | |
Maximum number of rows the QP should ever return. This is coming directly from the max rows allowed by Excel for now ... https://support.office.com/en-nz/article/Excel-specifications-and-limits-1672b34d-7043-467e-8e27-269d656771c3 This is actually one less than the number of rows allowed by Excel, since we have a header row. See #13585 for more details. TODO - I think this could go in the | (def absolute-max-results 1048575) |
Should we disable logging for the QP? (e.g., during sync we probably want to turn it off to keep logs less cluttered). TODO - maybe we should do this more generally with the help of a macro like TODO - I think we should just remove this entirely, it's not used consistently and it's more trouble than it's worth. Just dial down the log level a bit where we're currently using this | (def ^:dynamic ^Boolean *disable-qp-logging* false) |
(ns metabase.query-processor.middleware.add-default-temporal-unit (:require [metabase.lib.metadata :as lib.metadata] [metabase.mbql.util :as mbql.u] [metabase.query-processor.store :as qp.store])) | |
Add | (defn add-default-temporal-unit
[query]
(mbql.u/replace-in query [:query]
[:field (_ :guard string?) (_ :guard (every-pred
:base-type
#(isa? (:base-type %) :type/Temporal)
(complement :temporal-unit)))]
(mbql.u/with-temporal-unit &match :default)
[:field (id :guard integer?) (_ :guard (complement :temporal-unit))]
(let [{:keys [base-type effective-type]} (lib.metadata/field (qp.store/metadata-provider) id)]
(cond-> &match
(isa? (or effective-type base-type) :type/Temporal) (mbql.u/with-temporal-unit :default))))) |
Middleware for adding remapping and other dimension related projections. This remaps Fields that have a corresponding
Dimension object (which defines a remapping) in two different ways, depending on the
In both cases, to accomplish values replacement on the frontend, the post-processing part of this middleware adds
appropriate See also [[metabase.models.params.chain-filter]] for another explanation of remapping. | (ns metabase.query-processor.middleware.add-dimension-projections (:require [clojure.data :as data] [clojure.walk :as walk] [medley.core :as m] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.jvm :as lib.metadata.jvm] [metabase.lib.metadata.protocols :as lib.metadata.protocols] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.id :as lib.schema.id] [metabase.mbql.schema :as mbql.s] [metabase.mbql.schema.helpers :as helpers] [metabase.mbql.util :as mbql.u] [metabase.query-processor.store :as qp.store] [metabase.util :as u] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms])) |
Schema for the info we fetch about | (def ^:private ExternalRemappingDimension [:map [:id ms/PositiveInt] ; unique ID for the remapping [:name ms/NonBlankString] ; display name for the remapping [:field-id ms/PositiveInt] ; ID of the Field being remapped [:field-name ms/NonBlankString] ; Name of the Field being remapped [:human-readable-field-id ms/PositiveInt] ; ID of the FK Field to remap values to [:human-readable-field-name ms/NonBlankString]]) ; Name of the FK Field to remap values to |
Pre-processing | |
(mu/defn ^:private fields->field-id->remapping-dimension :- [:maybe [:map-of ::lib.schema.id/field ExternalRemappingDimension]]
"Given a sequence of field clauses (from the `:fields` clause), return a map of `:field-id` clause (other clauses
are ineligable) to a remapping dimension information for any Fields that have an `external` type dimension remapping."
[fields :- [:maybe [:sequential mbql.s/Field]]]
(when-let [field-ids (not-empty (set (mbql.u/match fields [:field (id :guard integer?) _] id)))]
(let [field-metadatas (qp.store/bulk-metadata :metadata/column field-ids)]
(when-let [remap-field-ids (not-empty (into #{}
(keep (comp :field-id :lib/external-remap))
field-metadatas))]
;; do a bulk fetch of the remaps.
(qp.store/bulk-metadata :metadata/column remap-field-ids)
(into {}
(comp (filter :lib/external-remap)
(keep (fn [field]
(let [{remap-id :id, remap-name :name, remap-field-id :field-id} (:lib/external-remap field)
remap-field (lib.metadata.protocols/field
(qp.store/metadata-provider)
remap-field-id)]
(when remap-field
[(:id field) {:id remap-id
:name remap-name
:field-id (:id field)
:field-name (:name field)
:human-readable-field-id remap-field-id
:human-readable-field-name (:name remap-field)}])))))
field-metadatas))))) | |
(def ^:private RemapColumnInfo [:map [:original-field-clause mbql.s/field] [:new-field-clause mbql.s/field] [:dimension ExternalRemappingDimension]]) | |
(mu/defn ^:private remap-column-infos :- [:maybe [:sequential RemapColumnInfo]]
"Return tuples of `:field-id` clauses, the new remapped column `:fk->` clauses that the Field should be remapped to
and the Dimension that suggested the remapping, which is used later in this middleware for post-processing. Order is
important here, because the results are added to the `:fields` column in order. (TODO - why is it important, if they
get hidden when displayed anyway?)"
[fields :- [:maybe [:sequential mbql.s/Field]]]
(when-let [field-id->remapping-dimension (fields->field-id->remapping-dimension fields)]
;; Reconstruct how we uniquify names in [[metabase.query-processor.middleware.annotate]]
;;
;; Not sure this isn't broken. Probably better to have [[metabase.query-processor.util.add-alias-info]] do the name
;; deduplication instead.
(let [name-generator (mbql.u/unique-name-generator)
unique-name (fn [field-id]
(assert (pos-int? field-id) (str "Invalid Field ID: " (pr-str field-id)))
(let [field (lib.metadata/field (qp.store/metadata-provider) field-id)]
(name-generator (:name field))))]
(vec
(mbql.u/match fields
;; don't match Fields that have been joined from another Table
[:field
(id :guard (every-pred integer? field-id->remapping-dimension))
(_ :guard (complement (some-fn :join-alias :source-field)))]
(let [dimension (field-id->remapping-dimension id)]
{:original-field-clause &match
:new-field-clause [:field
(u/the-id (:human-readable-field-id dimension))
{:source-field id
::new-field-dimension-id (u/the-id dimension)}]
:dimension (assoc dimension
:field-name (-> dimension :field-id unique-name)
:human-readable-field-name (-> dimension :human-readable-field-id unique-name))})))))) | |
(mu/defn ^:private add-fk-remaps-rewrite-existing-fields-add-original-field-dimension-id :- [:maybe [:sequential mbql.s/Field]]
"Rewrite existing `:fields` in a query. Add `::original-field-dimension-id` to any Field clauses that are
remapped-from."
[infos :- [:maybe [:sequential RemapColumnInfo]]
fields :- [:maybe [:sequential mbql.s/Field]]]
(let [field->remapped-col (into {} (map (juxt :original-field-clause :new-field-clause)) infos)]
(mapv
(fn [field]
(let [[_ _ {::keys [new-field-dimension-id]}] (get field->remapped-col field)]
(cond-> field
new-field-dimension-id (mbql.u/update-field-options assoc ::original-field-dimension-id new-field-dimension-id))))
fields))) | |
(mu/defn ^:private add-fk-remaps-rewrite-existing-fields-add-new-field-dimension-id :- [:maybe [:sequential mbql.s/Field]]
"Rewrite existing `:fields` in a query. Add `::new-field-dimension-id` to any existing remap-to Fields that *would*
have been added if they did not already exist."
[infos :- [:maybe [:sequential RemapColumnInfo]]
fields :- [:maybe [:sequential mbql.s/Field]]]
(let [normalized-clause->new-options (into {}
(map (juxt (fn [{clause :new-field-clause}]
(mbql.u/remove-namespaced-options clause))
(fn [{[_ _ options] :new-field-clause}]
options)))
infos)]
(mapv (fn [field]
(let [options (normalized-clause->new-options (mbql.u/remove-namespaced-options field))]
(cond-> field
options (mbql.u/update-field-options merge options))))
fields))) | |
(mu/defn ^:private add-fk-remaps-rewrite-existing-fields :- [:maybe [:sequential mbql.s/Field]]
"Rewrite existing `:fields` in a query. Add `::original-field-dimension-id` and ::new-field-dimension-id` where
appropriate."
[infos :- [:maybe [:sequential RemapColumnInfo]]
fields :- [:maybe [:sequential mbql.s/Field]]]
(->> fields
(add-fk-remaps-rewrite-existing-fields-add-original-field-dimension-id infos)
(add-fk-remaps-rewrite-existing-fields-add-new-field-dimension-id infos))) | |
(mu/defn ^:private add-fk-remaps-rewrite-order-by :- [:maybe [:sequential mbql.s/OrderBy]]
"Order by clauses that include an external remapped column should be replace that original column in the order by with
the newly remapped column. This should order by the text of the remapped column vs. the id of the source column
before the remapping"
[field->remapped-col :- [:map-of mbql.s/field mbql.s/field]
order-by-clauses :- [:maybe [:sequential mbql.s/OrderBy]]]
(into []
(comp (map (fn [[direction field, :as order-by-clause]]
(if-let [remapped-col (get field->remapped-col field)]
[direction remapped-col]
order-by-clause)))
(distinct))
order-by-clauses)) | |
(defn- add-fk-remaps-rewrite-breakout
[field->remapped-col breakout-clause]
(into []
(comp (mapcat (fn [field]
(if-let [[_ _ {::keys [new-field-dimension-id]} :as remapped-col] (get field->remapped-col field)]
[remapped-col (mbql.u/update-field-options field assoc ::original-field-dimension-id new-field-dimension-id)]
[field])))
(distinct))
breakout-clause)) | |
(def ^:private QueryAndRemaps [:map [:remaps [:maybe (helpers/distinct [:sequential ExternalRemappingDimension])]] [:query mbql.s/Query]]) | |
(defn- add-fk-remaps-one-level
[{:keys [fields order-by breakout], {source-query-remaps ::remaps} :source-query, :as query}]
(let [query (m/dissoc-in query [:source-query ::remaps])]
;; fetch remapping column pairs if any exist...
(if-let [infos (not-empty (remap-column-infos (concat fields breakout)))]
;; if they do, update `:fields`, `:order-by` and `:breakout` clauses accordingly and add to the query
(let [ ;; make a map of field-id-clause -> fk-clause from the tuples
original->remapped (into {} (map (juxt :original-field-clause :new-field-clause)) infos)
existing-fields (add-fk-remaps-rewrite-existing-fields infos fields)
;; don't add any new entries for fields that already exist. Use [[mbql.u/remove-namespaced-options]] here so
;; we don't add new entries even if the existing Field has some extra info e.g. extra unknown namespaced
;; keys.
existing-normalized-fields-set (into #{} (map mbql.u/remove-namespaced-options) existing-fields)
new-fields (into
existing-fields
(comp (map :new-field-clause)
(remove (comp existing-normalized-fields-set mbql.u/remove-namespaced-options)))
infos)
new-breakout (add-fk-remaps-rewrite-breakout original->remapped breakout)
new-order-by (add-fk-remaps-rewrite-order-by original->remapped order-by)
remaps (into [] (comp cat (distinct)) [source-query-remaps (map :dimension infos)])]
;; return the Dimensions we are using and the query
(cond-> query
(seq fields) (assoc :fields new-fields)
(seq order-by) (assoc :order-by new-order-by)
(seq breakout) (assoc :breakout new-breakout)
(seq remaps) (assoc ::remaps remaps)))
;; otherwise return query as-is
(cond-> query
(seq source-query-remaps) (assoc ::remaps source-query-remaps))))) | |
(mu/defn ^:private add-fk-remaps :- QueryAndRemaps
"Add any Fields needed for `:external` remappings to the `:fields` clause of the query, and update `:order-by` and
`breakout` clauses as needed. Returns a map with `:query` (the updated query) and `:remaps` (a sequence
of [[:sequential ExternalRemappingDimension]] information maps)."
[query]
(let [query (walk/postwalk
(fn [form]
(if (and (map? form)
((some-fn :source-table :source-query) form)
(not (:condition form)))
(add-fk-remaps-one-level form)
form))
query)]
{:query (m/dissoc-in query [:query ::remaps]), :remaps (get-in query [:query ::remaps])})) | |
Pre-processing middleware. For columns that have remappings to other columns (FK remaps), rewrite the query to
include the extra column. Add | (defn add-remapped-columns
[{{:keys [disable-remaps?]} :middleware, query-type :type, :as query}]
(if (or disable-remaps?
(= query-type :native))
query
(let [{:keys [remaps query]} (add-fk-remaps query)]
(cond-> query
;; convert the remappings to plain maps so we don't have to look at record type nonsense everywhere
(seq remaps) (assoc ::external-remaps (mapv (partial into {}) remaps)))))) |
Post-processing | |
(def ^:private InternalDimensionInfo [:map ;; index of original column [:col-index :int] ;; names [:from ms/NonBlankString] ;; I'm not convinced this works if there's already a column with the same name in the results. [:to ms/NonBlankString] ;; map of original value -> human readable value [:value->readable :map] ;; Info about the new column we will tack on to end of `:cols` [:new-column :map]]) | |
(def ^:private InternalColumnsInfo [:map [:internal-only-dims [:maybe [:sequential InternalDimensionInfo]]] ;; this is just (map :new-column internal-only-dims) [:internal-only-cols [:maybe [:sequential :map]]]]) | |
Metadata | |
(mu/defn ^:private merge-metadata-for-internally-remapped-column :- [:maybe [:sequential :map]]
"If one of the internal remapped columns says it's remapped from this column, merge in the `:remapped_to` info."
[columns :- [:maybe [:sequential :map]]
{:keys [col-index to]} :- InternalDimensionInfo]
(update (vec columns) col-index assoc :remapped_to to)) | |
(mu/defn ^:private merge-metadata-for-internal-remaps :- [:maybe [:sequential :map]]
[columns :- [:maybe [:sequential :map]]
{:keys [internal-only-dims]} :- [:maybe InternalColumnsInfo]]
(reduce
merge-metadata-for-internally-remapped-column
columns
internal-only-dims)) | |
Example external dimension: {:name "Sender ID" :id 1000 :fieldid %messages.senderid :fieldname "SENDERID" :human-readable-field-id %users.name :human-readable-field-name "NAME"} Example remap-from column (need to add info about column it is {:id %messages.sender_id :name "SENDER_ID" :options {::original-field-dimension-id 1000} :display_name "Sender ID"} Example remap-to column (need to add info about column it is {:fkfieldid %messages.sender_id :id %users.name :options {::new-field-dimension-id 1000} :name "NAME" :display_name "Sender ID"} | (mu/defn ^:private merge-metadata-for-externally-remapped-column* :- :map
[columns
{{::keys [original-field-dimension-id new-field-dimension-id]} :options
:as column} :- :map
{dimension-id :id
from-name :field_name
from-display-name :name
to-name :human-readable-field-name} :- ExternalRemappingDimension]
(log/trace "Considering column\n"
(u/pprint-to-str 'cyan (select-keys column [:id :name :fk_field_id :display_name :options]))
(u/colorize :magenta "\nAdd :remapped_to metadata?")
"\n=>" '(= dimension-id original-field-dimension-id)
"\n=>" (list '= dimension-id original-field-dimension-id)
"\n=>" (if (= dimension-id original-field-dimension-id)
(u/colorize :green true)
(u/colorize :red false))
(u/colorize :magenta "\nAdd :remapped_from metadata?")
"\n=>" '(= dimension-id new-field-dimension-id)
"\n=>" (list '= dimension-id new-field-dimension-id)
"\n=>" (if (= dimension-id new-field-dimension-id)
(u/colorize :green true)
(u/colorize :red false)))
(u/prog1 (merge
column
;; if this is a column we're remapping FROM, we need to add information about which column we're remapping
;; TO
(when (= dimension-id original-field-dimension-id)
{:remapped_to (or (some (fn [{{::keys [new-field-dimension-id]} :options, target-name :name}]
(when (= new-field-dimension-id dimension-id)
target-name))
columns)
to-name)})
;; if this is a column we're remapping TO, we need to add information about which column we're remapping
;; FROM
(when (= dimension-id new-field-dimension-id)
{:remapped_from (or (some (fn [{{::keys [original-field-dimension-id]} :options, source-name :name}]
(when (= original-field-dimension-id dimension-id)
source-name))
columns)
from-name)
:display_name from-display-name}))
(when (not= column <>)
(log/tracef "Added metadata:\n%s" (u/pprint-to-str 'green (second (data/diff column <>))))))) |
(mu/defn ^:private merge-metadata-for-externally-remapped-column :- [:maybe [:sequential :map]]
[columns :- [:maybe [:sequential :map]] dimension :- ExternalRemappingDimension]
(log/tracef "Merging metadata for external dimension\n%s" (u/pprint-to-str 'yellow (into {} dimension)))
(mapv #(merge-metadata-for-externally-remapped-column* columns % dimension)
columns)) | |
(mu/defn ^:private merge-metadata-for-external-remaps :- [:maybe [:sequential :map]] [columns :- [:maybe [:sequential :map]] remapping-dimensions :- [:maybe [:sequential ExternalRemappingDimension]]] (reduce merge-metadata-for-externally-remapped-column columns remapping-dimensions)) | |
(mu/defn ^:private add-remapping-info :- [:maybe [:sequential :map]]
"Add `:display_name`, `:remapped_to`, and `:remapped_from` keys to columns for the results, needed by the frontend.
To get this critical information, this uses the `remapping-dimensions` info saved by the pre-processing portion of
this middleware for external remappings, and the internal-only remapped columns handled by post-processing
middleware below for internal columns."
[columns :- [:maybe [:sequential :map]]
remapping-dimensions :- [:maybe [:sequential ExternalRemappingDimension]]
internal-cols-info :- [:maybe InternalColumnsInfo]]
(-> columns
(merge-metadata-for-internal-remaps internal-cols-info)
(merge-metadata-for-external-remaps remapping-dimensions))) | |
Transform to add additional cols to results | |
(defn- create-remapped-col [col-name remapped-from base-type]
{:description nil
:id nil
:table_id nil
:name col-name
:display_name col-name
:target nil
:remapped_from remapped-from
:remapped_to nil
:base_type base-type
:semantic_type nil}) | |
Converts | (defn- transform-values-for-col
[{:keys [base-type], :as _column-metadata} values]
(let [transform (condp #(isa? %2 %1) base-type
:type/Decimal bigdec
:type/Float double
:type/BigInteger bigint
:type/Integer int
:type/Text str
identity)]
(map #(some-> % transform) values))) |
(defn- infer-human-readable-values-type
[values]
(let [types (keys (group-by (fn [v]
(cond
(string? v) :type/Text
(number? v) :type/Number
:else :type/*))
values))]
(if (= (count types) 1)
(first types)
:type/*))) | |
ColumnMetadata, but | (def ^:private ColumnMetadataWithOptionalBaseType
[:merge
lib.metadata/ColumnMetadata
[:map
[:base-type {:optional true} ::lib.schema.common/base-type]]]) |
(mu/defn ^:private col->dim-map :- [:maybe InternalDimensionInfo]
"Given a `:col` map from the results, return a map of information about the `internal` dimension used for remapping
it."
[idx :- ::lib.schema.common/int-greater-than-or-equal-to-zero
{{:keys [values human-readable-values], remap-to :name} :lib/internal-remap
:as col} :- ColumnMetadataWithOptionalBaseType]
(when (seq values)
(let [remap-from (:name col)]
{:col-index idx
:from remap-from
:to remap-to
:value->readable (zipmap (transform-values-for-col col values)
human-readable-values)
:new-column (create-remapped-col remap-to
remap-from
(infer-human-readable-values-type human-readable-values))}))) | |
(mu/defn ^:private make-row-map-fn :- [:maybe fn?]
"Return a function that will add internally-remapped values to each row in the results. (If there is no remapping to
be done, this function returns `nil`.)"
[dims :- [:maybe [:sequential InternalDimensionInfo]]]
(when (seq dims)
(let [f (apply juxt (for [{:keys [col-index value->readable]} dims]
(fn [row]
(value->readable (nth row col-index)))))]
(fn [row]
(into (vec row) (f row)))))) | |
(mu/defn ^:private internal-columns-info :- InternalColumnsInfo
"Info about the internal-only columns we add to the query."
[cols :- [:maybe [:sequential ColumnMetadataWithOptionalBaseType]]]
;; hydrate Dimensions and FieldValues for all of the columns in the results, then make a map of dimension info for
;; each one that is `internal` type
(let [internal-only-dims (keep-indexed col->dim-map cols)]
{:internal-only-dims internal-only-dims
;; Get the entries we're going to add to `:cols` for each of the remapped values we add
:internal-only-cols (map :new-column internal-only-dims)})) | |
Add remapping info | (mu/defn ^:private add-remapped-to-and-from-metadata
[metadata :- [:map
[:cols [:maybe [:sequential :map]]]]
remapping-dimensions :- [:maybe [:sequential ExternalRemappingDimension]]
{:keys [internal-only-cols], :as internal-cols-info} :- [:maybe InternalColumnsInfo]]
(update metadata :cols (fn [cols]
(-> cols
(add-remapping-info remapping-dimensions internal-cols-info)
(concat internal-only-cols))))) |
Munges results for remapping after the query has been executed. For internal remappings, a new column needs to be added and each row flowing through needs to include the remapped data for the new column. For external remappings the column information needs to be updated with what it's being remapped from and the user specified name for the remapped column. | (mu/defn ^:private remap-results-xform
[{:keys [internal-only-dims]} :- InternalColumnsInfo rf]
(if-let [remap-fn (make-row-map-fn internal-only-dims)]
((map remap-fn) rf)
rf)) |
Post-processing middleware. Handles | (defn remap-results
[{::keys [external-remaps], {:keys [disable-remaps?]} :middleware} rff]
(if disable-remaps?
rff
(fn remap-results-rff* [metadata]
(let [mlv2-cols (map
#(lib.metadata.jvm/instance->metadata % :metadata/column)
(:cols metadata))
internal-cols-info (internal-columns-info mlv2-cols)
metadata (add-remapped-to-and-from-metadata metadata external-remaps internal-cols-info)]
(remap-results-xform internal-cols-info (rff metadata)))))) |
Middlware for adding an implicit | (ns metabase.query-processor.middleware.add-implicit-clauses (:require [clojure.walk :as walk] [metabase.lib.metadata :as lib.metadata] [metabase.lib.types.isa :as lib.types.isa] [metabase.mbql.schema :as mbql.s] [metabase.mbql.util :as mbql.u] [metabase.query-processor.error-type :as qp.error-type] [metabase.query-processor.store :as qp.store] [metabase.util :as u] [metabase.util.i18n :refer [trs tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms])) |
+----------------------------------------------------------------------------------------------------------------+ | Add Implicit Fields | +----------------------------------------------------------------------------------------------------------------+ | |
Return a sequence of all Fields for table that we'd normally include in the equivalent of a | (defn- table->sorted-fields
[table-id]
(->> (lib.metadata/fields (qp.store/metadata-provider) table-id)
(remove :parent-id)
(remove #(#{:sensitive :retired} (:visibility-type %)))
(sort-by (juxt :position (comp u/lower-case-en :name))))) |
(mu/defn sorted-implicit-fields-for-table :- mbql.s/Fields
"For use when adding implicit Field IDs to a query. Return a sequence of field clauses, sorted by the rules listed
in [[metabase.query-processor.sort]], for all the Fields in a given Table."
[table-id :- ms/PositiveInt]
(let [fields (table->sorted-fields table-id)]
(when (empty? fields)
(throw (ex-info (tru "No fields found for table {0}." (pr-str (:name (lib.metadata/table (qp.store/metadata-provider) table-id))))
{:table-id table-id
:type qp.error-type/invalid-query})))
(mapv
(fn [field]
;; implicit datetime Fields get bucketing of `:default`. This is so other middleware doesn't try to give it
;; default bucketing of `:day`
[:field (u/the-id field) (when (lib.types.isa/temporal? field)
{:temporal-unit :default})])
fields))) | |
(mu/defn ^:private source-metadata->fields :- mbql.s/Fields
"Get implicit Fields for a query with a `:source-query` that has `source-metadata`."
[source-metadata :- [:sequential {:min 1} mbql.s/SourceQueryMetadata]]
(distinct
(for [{field-name :name, base-type :base_type, field-id :id, [ref-type :as field-ref] :field_ref coercion-strategy :coercion_strategy} source-metadata]
;; return field-ref directly if it's a `:field` clause already. It might include important info such as
;; `:join-alias` or `:source-field`. Remove binning/temporal bucketing info. The Field should already be getting
;; bucketed in the source query; don't need to apply bucketing again in the parent query. Mark the field as
;; `qp/ignore-coercion` here so that it doesn't happen again in the parent query.
(or (some-> (mbql.u/match-one field-ref :field)
(mbql.u/update-field-options dissoc :binning :temporal-unit)
(cond-> coercion-strategy (mbql.u/assoc-field-options :qp/ignore-coercion true)))
;; otherwise construct a field reference that can be used to refer to this Field.
;; Force string id field if expression contains just field. See issue #28451.
(if (and (not= ref-type :expression)
field-id)
;; If we have a Field ID, return a `:field` (id) clause
[:field field-id (cond-> nil coercion-strategy (assoc :qp/ignore-coercion true))]
;; otherwise return a `:field` (name) clause, e.g. for a Field that's the result of an aggregation or
;; expression. We don't need to mark as ignore-coercion here because these won't grab the field metadata
[:field field-name {:base-type base-type}]))))) | |
Whether we should add implicit Fields to this query. True if all of the following are true:
| (mu/defn ^:private should-add-implicit-fields?
[{:keys [fields source-table source-query source-metadata]
breakouts :breakout
aggregations :aggregation} :- mbql.s/MBQLQuery]
;; if someone is trying to include an explicit `source-query` but isn't specifiying `source-metadata` warn that
;; there's nothing we can do to help them
(when (and source-query
(empty? source-metadata)
(qp.store/initialized?))
;; by 'caching' this result, this log message will only be shown once for a given QP run.
(qp.store/cached [::should-add-implicit-fields-warning]
(log/warn (str (trs "Warning: cannot determine fields for an explicit `source-query` unless you also include `source-metadata`.")
\newline
(trs "Query: {0}" (u/pprint-to-str source-query))))))
;; Determine whether we can add the implicit `:fields`
(and (or source-table
(and source-query (seq source-metadata)))
(every? empty? [aggregations breakouts fields]))) |
For MBQL queries with no aggregation, add a | (mu/defn ^:private add-implicit-fields
[{source-table-id :source-table, :keys [expressions source-metadata], :as inner-query}]
(if-not (should-add-implicit-fields? inner-query)
inner-query
(let [fields (if source-table-id
(sorted-implicit-fields-for-table source-table-id)
(source-metadata->fields source-metadata))
;; generate a new expression ref clause for each expression defined in the query.
expressions (for [[expression-name] expressions]
;; TODO - we need to wrap this in `u/qualified-name` because `:expressions` uses
;; keywords as keys. We can remove this call once we fix that.
[:expression (u/qualified-name expression-name)])]
;; if the Table has no Fields, throw an Exception, because there is no way for us to proceed
(when-not (seq fields)
(throw (ex-info (tru "Table ''{0}'' has no Fields associated with it."
(:name (lib.metadata/table (qp.store/metadata-provider) source-table-id)))
{:type qp.error-type/invalid-query})))
;; add the fields & expressions under the `:fields` clause
(assoc inner-query :fields (vec (concat fields expressions)))))) |
+----------------------------------------------------------------------------------------------------------------+ | Add Implicit Breakout Order Bys | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn ^:private add-implicit-breakout-order-by :- mbql.s/MBQLQuery
"Fields specified in `breakout` should add an implicit ascending `order-by` subclause *unless* that Field is already
*explicitly* referenced in `order-by`."
[{breakouts :breakout, :as inner-query} :- mbql.s/MBQLQuery]
;; Add a new [:asc <breakout-field>] clause for each breakout. The cool thing is `add-order-by-clause` will
;; automatically ignore new ones that are reference Fields already in the order-by clause
(reduce mbql.u/add-order-by-clause inner-query (for [breakout breakouts]
[:asc breakout]))) | |
+----------------------------------------------------------------------------------------------------------------+ | Middleware | +----------------------------------------------------------------------------------------------------------------+ | |
Add implicit clauses such as | (defn add-implicit-mbql-clauses
[form]
(walk/postwalk
(fn [form]
;; add implicit clauses to any 'inner query', except for joins themselves (we should still add implicit clauses
;; like `:fields` to source queries *inside* joins)
(if (and (map? form)
((some-fn :source-table :source-query) form)
(not (:condition form)))
(-> form add-implicit-breakout-order-by add-implicit-fields)
form))
form)) |
Add an implicit | (defn add-implicit-clauses
[{query-type :type, :as query}]
(if (= query-type :native)
query
(update query :query add-implicit-mbql-clauses))) |
Middleware that creates corresponding | (ns metabase.query-processor.middleware.add-implicit-joins
(:refer-clojure :exclude [alias])
(:require
[clojure.set :as set]
[clojure.walk :as walk]
[medley.core :as m]
[metabase.driver :as driver]
[metabase.lib.metadata :as lib.metadata]
[metabase.lib.metadata.protocols :as lib.metadata.protocols]
[metabase.lib.schema.common :as lib.schema.common]
[metabase.lib.schema.id :as lib.schema.id]
[metabase.mbql.schema :as mbql.s]
[metabase.mbql.util :as mbql.u]
[metabase.query-processor.error-type :as qp.error-type]
[metabase.query-processor.middleware.add-implicit-clauses
:as qp.add-implicit-clauses]
[metabase.query-processor.store :as qp.store]
[metabase.util.i18n :refer [tru]]
[metabase.util.malli :as mu])) |
Find fields that come from implicit join in form | (defn- implicitly-joined-fields
[x]
(set (mbql.u/match x [:field _ (_ :guard (every-pred :source-field (complement :join-alias)))]
(when-not (some #{:source-metadata} &parents)
&match)))) |
(defn- join-alias [dest-table-name source-fk-field-name] (str dest-table-name "__via__" source-fk-field-name)) | |
(def ^:private JoinInfo [:map [:source-table ::lib.schema.id/table] [:alias ::lib.schema.common/non-blank-string] [:fields [:= :none]] [:strategy [:= :left-join]] [:condition mbql.s/=] [:fk-field-id ::lib.schema.id/field]]) | |
(mu/defn ^:private fk-ids->join-infos :- [:maybe [:sequential JoinInfo]]
"Given `fk-field-ids`, return a sequence of maps containing IDs and and other info needed to generate corresponding
`joined-field` and `:joins` clauses."
[fk-field-ids]
(when (seq fk-field-ids)
(let [fk-fields (qp.store/bulk-metadata :metadata/column fk-field-ids)
target-field-ids (into #{} (keep :fk-target-field-id) fk-fields)
target-fields (when (seq target-field-ids)
(qp.store/bulk-metadata :metadata/column fk-field-ids))
target-table-ids (into #{} (keep :table-id) target-fields)]
;; this is for cache-warming purposes.
(when (seq target-table-ids)
(qp.store/bulk-metadata :metadata/table target-table-ids))
(for [{fk-name :name, fk-field-id :id, pk-id :fk-target-field-id} fk-fields
:when pk-id]
(let [{source-table :table-id} (lib.metadata.protocols/field (qp.store/metadata-provider) pk-id)
{table-name :name} (lib.metadata.protocols/table (qp.store/metadata-provider) source-table)
alias-for-join (join-alias table-name fk-name)]
(-> {:source-table source-table
:alias alias-for-join
:fields :none
:strategy :left-join
:condition [:= [:field fk-field-id nil] [:field pk-id {:join-alias alias-for-join}]]
:fk-field-id fk-field-id}
(vary-meta assoc ::needs [:field fk-field-id nil]))))))) | |
Create implicit join maps for a set of | (defn- implicitly-joined-fields->joins
[field-clauses-with-source-field]
(distinct
(let [fk-field-ids (->> field-clauses-with-source-field
(map (fn [clause]
(mbql.u/match-one clause
[:field (id :guard integer?) (opts :guard (every-pred :source-field (complement :join-alias)))]
(:source-field opts))))
(filter integer?)
set
not-empty)]
(fk-ids->join-infos fk-field-ids)))) |
Set of all joins that are visible in the current level of the query or in a nested source query. | (defn- visible-joins
[{:keys [source-query joins]}]
(distinct
(into joins
(when source-query
(visible-joins source-query))))) |
(defn- distinct-fields [fields]
(m/distinct-by
(fn [field]
(mbql.u/replace (mbql.u/remove-namespaced-options field)
[:field id-or-name (opts :guard map?)]
[:field id-or-name (not-empty (dissoc opts :base-type :effective-type))]))
fields)) | |
(mu/defn ^:private construct-fk-field-id->join-alias :- [:map-of
::lib.schema.id/field
::lib.schema.common/non-blank-string]
[form]
;; Build a map of FK Field ID -> alias used for IMPLICIT joins. Only implicit joins have `:fk-field-id`
(into {}
(comp (map (fn [{:keys [fk-field-id], join-alias :alias}]
(when fk-field-id
[fk-field-id join-alias])))
;; only keep the first alias for each FK Field ID
(m/distinct-by first))
(visible-joins form))) | |
Add | (defn- add-implicit-joins-aliases-to-metadata
[{:keys [source-query] :as query}]
(let [fk-field-id->join-alias (construct-fk-field-id->join-alias source-query)]
(update query :source-metadata
#(mbql.u/replace %
[:field id-or-name (opts :guard (every-pred :source-field (complement :join-alias)))]
(let [join-alias (fk-field-id->join-alias (:source-field opts))]
(if (some? join-alias)
[:field id-or-name (assoc opts :join-alias join-alias)]
&match)))))) |
Add | (defn- add-join-alias-to-fields-with-source-field
[form]
(let [fk-field-id->join-alias (construct-fk-field-id->join-alias form)]
(cond-> (mbql.u/replace form
[:field id-or-name (opts :guard (every-pred :source-field (complement :join-alias)))]
(if-not (some #{:source-metadata} &parents)
(let [join-alias (or (fk-field-id->join-alias (:source-field opts))
(throw (ex-info (tru "Cannot find matching FK Table ID for FK Field {0}"
(format "%s %s"
(pr-str (:source-field opts))
(let [field (lib.metadata/field
(qp.store/metadata-provider)
(:source-field opts))]
(pr-str (:display-name field)))))
{:resolving &match
:candidates fk-field-id->join-alias
:form form})))]
[:field id-or-name (assoc opts :join-alias join-alias)])
&match))
(sequential? (:fields form)) (update :fields distinct-fields)))) |
Whether the current query level already has a join with the same alias. | (defn- already-has-join?
[{:keys [joins source-query]} {join-alias :alias, :as join}]
(or (some #(= (:alias %) join-alias)
joins)
(when source-query
(recur source-query join)))) |
Add any fields that are needed for newly-added join conditions to source query | (defn- add-condition-fields-to-source
[{{source-query-fields :fields} :source-query, :keys [joins], :as form}]
(if (empty? source-query-fields)
form
(let [needed (set (filter some? (map (comp ::needs meta) joins)))]
(update-in form [:source-query :fields] (fn [existing-fields]
(distinct-fields (concat existing-fields needed))))))) |
(defn- add-referenced-fields-to-source [form reused-joins]
(let [reused-join-alias? (set (map :alias reused-joins))
referenced-fields (set (mbql.u/match (dissoc form :source-query :joins)
[:field _ (_ :guard (fn [{:keys [join-alias]}]
(reused-join-alias? join-alias)))]
&match))]
(update-in form [:source-query :fields] (fn [existing-fields]
(distinct-fields
(concat existing-fields referenced-fields)))))) | |
(defn- add-fields-to-source
[{{source-query-fields :fields, :as source-query} :source-query, :as form} reused-joins]
(cond
(not source-query)
form
(:native source-query)
form
(seq ((some-fn :aggregation :breakout) source-query))
form
:else
(let [form (cond-> form
(empty? source-query-fields) (update :source-query qp.add-implicit-clauses/add-implicit-mbql-clauses))]
(if (empty? (get-in form [:source-query :fields]))
form
(-> form
add-condition-fields-to-source
(add-referenced-fields-to-source reused-joins)))))) | |
Get a set of join aliases that | (defn- join-dependencies
[join]
(set
(mbql.u/match (:condition join)
[:field _ (opts :guard :join-alias)]
(let [{:keys [join-alias]} opts]
(when-not (= join-alias (:alias join))
join-alias))))) |
Sort | (defn- topologically-sort-joins
[joins]
(let [ ;; make a map of join alias -> immediate dependencies
join->immediate-deps (into {}
(map (fn [join]
[(:alias join) (join-dependencies join)]))
joins)
;; make a map of join alias -> immediate and transient dependencies
all-deps (fn all-deps [join-alias]
(let [immediate-deps (set (get join->immediate-deps join-alias))]
(into immediate-deps
(mapcat all-deps)
immediate-deps)))
join->all-deps (into {}
(map (fn [[join-alias]]
[join-alias (all-deps join-alias)]))
join->immediate-deps)
;; now we can create a function to decide if one join depends on another
depends-on? (fn [join-1 join-2]
(contains? (join->all-deps (:alias join-1))
(:alias join-2)))]
(->> ;; add a key to each join to record its original position
(map-indexed (fn [i join]
(assoc join ::original-position i)) joins)
;; sort the joins by topological order falling back to preserving original position
(sort (fn [join-1 join-2]
(cond
(depends-on? join-1 join-2) 1
(depends-on? join-2 join-1) -1
:else (compare (::original-position join-1)
(::original-position join-2)))))
;; remove the keys we used to record original position
(mapv (fn [join]
(dissoc join ::original-position)))))) |
Add new | (defn- resolve-implicit-joins-this-level
[form]
(let [implicitly-joined-fields (implicitly-joined-fields form)
new-joins (implicitly-joined-fields->joins implicitly-joined-fields)
required-joins (remove (partial already-has-join? form) new-joins)
reused-joins (set/difference (set new-joins) (set required-joins))]
(cond-> form
(seq required-joins) (update :joins (fn [existing-joins]
(m/distinct-by
:alias
(concat existing-joins required-joins))))
true add-join-alias-to-fields-with-source-field
true (add-fields-to-source reused-joins)
(seq required-joins) (update :joins topologically-sort-joins)))) |
(defn- resolve-implicit-joins [query]
(let [has-source-query-and-metadata? (every-pred map? :source-query :source-metadata)
query? (every-pred map? (some-fn :source-query :source-table) #(not (contains? % :condition)))]
(walk/postwalk
(fn [form]
(cond-> form
;; `:source-metadata` of `:source-query` in this `form` are on this level. This `:source-query` has already
;; its implicit joins resolved by `postwalk`. The following code updates its metadata too.
(has-source-query-and-metadata? form)
add-implicit-joins-aliases-to-metadata
(query? form)
resolve-implicit-joins-this-level))
query))) | |
+----------------------------------------------------------------------------------------------------------------+ | Middleware | +----------------------------------------------------------------------------------------------------------------+ | |
Fetch and store any Tables other than the source Table referred to by This middleware also adds | (defn add-implicit-joins
[query]
(if (mbql.u/match-one (:query query) [:field _ (_ :guard (every-pred :source-field (complement :join-alias)))])
(do
(when-not (driver/database-supports? driver/*driver* :foreign-keys (lib.metadata/database (qp.store/metadata-provider)))
(throw (ex-info (tru "{0} driver does not support foreign keys." driver/*driver*)
{:driver driver/*driver*
:type qp.error-type/unsupported-feature})))
(update query :query resolve-implicit-joins))
query)) |
Adds | (ns metabase.query-processor.middleware.add-rows-truncated (:require [metabase.query-processor.interface :as qp.i] [metabase.query-processor.middleware.limit :as limit])) |
(defn- results-limit
[{{:keys [max-results max-results-bare-rows]} :constraints
{aggregations :aggregation, :keys [limit page], ::limit/keys [original-limit]} :query
:as _query}]
(or (when (and (or (not limit)
(= original-limit nil))
(not page)
(empty? aggregations))
max-results-bare-rows)
max-results
qp.i/absolute-max-results)) | |
(defn- add-rows-truncated-xform [limit rf]
{:pre [(int? limit) (fn? rf)]}
(let [row-count (volatile! 0)]
(fn
([]
(rf))
([result]
(rf (cond-> result
(and (map? result)
(= @row-count limit))
(assoc-in [:data :rows_truncated] limit))))
([result row]
(vswap! row-count inc)
(rf result row))))) | |
Add | (defn add-rows-truncated
[query rff]
(fn add-rows-truncated-rff* [metadata]
(add-rows-truncated-xform (results-limit query) (rff metadata)))) |
(ns metabase.query-processor.middleware.add-source-metadata (:require [clojure.walk :as walk] [metabase.api.common :as api] [metabase.lib.metadata :as lib.metadata] [metabase.mbql.schema :as mbql.s] [metabase.mbql.util :as mbql.u] [metabase.query-processor.interface :as qp.i] [metabase.query-processor.store :as qp.store] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [metabase.util.malli :as mu])) | |
Whether this source query itself has a nested source query, and will have the exact same fields in the results as its
nested source. If this is the case, we can return the | (defn- has-same-fields-as-nested-source?
[{nested-source-query :source-query
nested-source-metadata :source-metadata
breakouts :breakout
aggregations :aggregation
fields :fields}]
(when nested-source-query
(and (every? empty? [breakouts aggregations])
(or (empty? fields)
(and (= (count fields) (count nested-source-metadata))
(every? #(mbql.u/match-one % [:field (_ :guard string?) _])
fields)))))) |
(mu/defn ^:private native-source-query->metadata :- [:maybe [:sequential mbql.s/SourceQueryMetadata]]
"Given a `source-query`, return the source metadata that should be added at the parent level (i.e., at the same
level where this `source-query` was present.) This metadata is used by other middleware to determine what Fields to
expect from the source query."
[{nested-source-metadata :source-metadata, :as source-query} :- mbql.s/SourceQuery]
;; If the source query has a nested source with metadata and does not change the fields that come back, return
;; metadata as-is
(if (has-same-fields-as-nested-source? source-query)
nested-source-metadata
;; Otherwise we cannot determine the metadata automatically; usually, this is because the source query itself has
;; a native source query
(do
(when-not qp.i/*disable-qp-logging*
(log/warn
(trs "Cannot infer `:source-metadata` for source query with native source query without source metadata.")
{:source-query source-query}))
nil))) | |
(mu/defn mbql-source-query->metadata :- [:maybe [:sequential mbql.s/SourceQueryMetadata]]
"Preprocess a `source-query` so we can determine the result columns."
[source-query :- mbql.s/MBQLQuery]
(try
(let [cols (binding [api/*current-user-id* nil]
((requiring-resolve 'metabase.query-processor/query->expected-cols)
{:database (:id (lib.metadata/database (qp.store/metadata-provider)))
:type :query
;; don't add remapped columns to the source metadata for the source query, otherwise we're going
;; to end up adding it again when the middleware runs at the top level
:query (assoc-in source-query [:middleware :disable-remaps?] true)}))]
(for [col cols]
(select-keys col [:name :id :table_id :display_name :base_type :effective_type :coercion_strategy
:semantic_type :unit :fingerprint :settings :source_alias :field_ref :nfc_path :parent_id])))
(catch Throwable e
(log/error e (str (trs "Error determining expected columns for query: {0}" (ex-message e))))
nil))) | |
(mu/defn ^:private add-source-metadata :- [:map
[:source-metadata
{:optional true}
[:maybe [:sequential mbql.s/SourceQueryMetadata]]]]
[{{native-source-query? :native, :as source-query} :source-query, :as inner-query} :- :map]
(let [metadata ((if native-source-query?
native-source-query->metadata
mbql-source-query->metadata) source-query)]
(cond-> inner-query
(seq metadata) (assoc :source-metadata metadata)))) | |
Whether this source metadata is legacy source metadata from < 0.38.0. Legacy source metadata did not include
| (defn- legacy-source-metadata?
[source-metadata]
(and (seq source-metadata)
(every? nil? (map :field_ref source-metadata)))) |
Should we add
| (defn- should-add-source-metadata?
[{{native-source-query? :native
source-query-has-source-metadata? :source-metadata
:as source-query} :source-query
:keys [source-metadata]}]
(and source-query
(or (not source-metadata)
(legacy-source-metadata? source-metadata))
(or (not native-source-query?)
source-query-has-source-metadata?))) |
(defn- maybe-add-source-metadata [x]
(if (and (map? x) (should-add-source-metadata? x))
(add-source-metadata x)
x)) | |
(defn- add-source-metadata-at-all-levels [inner-query] (walk/postwalk maybe-add-source-metadata inner-query)) | |
Middleware that attempts to recursively add
| (defn add-source-metadata-for-source-queries
[{query-type :type, :as query}]
(if-not (= query-type :query)
query
(update query :query add-source-metadata-at-all-levels))) |
(ns metabase.query-processor.middleware.add-timezone-info (:require [metabase.query-processor.timezone :as qp.timezone])) | |
(defn- add-timezone-metadata [metadata]
(merge
metadata
{:results_timezone (qp.timezone/results-timezone-id)}
(when-let [requested-timezone-id (qp.timezone/requested-timezone-id)]
{:requested_timezone requested-timezone-id}))) | |
Add | (defn add-timezone-info
[_query rff]
(fn add-timezone-info-rff* [metadata]
(rff (add-timezone-metadata metadata)))) |
Middleware for annotating (adding type information to) the results of a query, under the | (ns metabase.query-processor.middleware.annotate
(:require
[clojure.set :as set]
[clojure.string :as str]
[medley.core :as m]
[metabase.driver.common :as driver.common]
[metabase.lib.convert :as lib.convert]
[metabase.lib.core :as lib]
[metabase.lib.metadata :as lib.metadata]
[metabase.lib.metadata.calculation :as lib.metadata.calculation]
[metabase.lib.schema.common :as lib.schema.common]
[metabase.mbql.normalize :as mbql.normalize]
[metabase.mbql.schema :as mbql.s]
[metabase.mbql.util :as mbql.u]
[metabase.mbql.util.match :as mbql.match]
[metabase.models.humanization :as humanization]
[metabase.query-processor.error-type :as qp.error-type]
[metabase.query-processor.middleware.escape-join-aliases
:as escape-join-aliases]
[metabase.query-processor.reducible :as qp.reducible]
[metabase.query-processor.store :as qp.store]
[metabase.query-processor.util :as qp.util]
[metabase.sync.analyze.fingerprint.fingerprinters :as fingerprinters]
[metabase.util :as u]
[metabase.util.i18n :refer [deferred-tru tru]]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms])) |
Schema for a valid map of column info as found in the | (def ^:private Col
;; name and display name can be blank because some wacko DBMSes like SQL Server return blank column names for
;; unaliased aggregations like COUNT(*) (this only applies to native queries, since we determine our own names for
;; MBQL.)
[:map
[:name :string]
[:display_name :string]
;; type of the Field. For Native queries we look at the values in the first 100 rows to make an educated guess
[:base_type ms/FieldType]
;; effective_type, coercion, etc don't go here. probably best to rename base_type to effective type in the return
;; from the metadata but that's for another day
;; where this column came from in the original query.
[:source [:enum :aggregation :fields :breakout :native]]
;; a field clause that can be used to refer to this Field if this query is subsequently used as a source query.
;; Added by this middleware as one of the last steps.
[:field_ref {:optional true} mbql.s/Reference]]) |
Determine the TODO - I think we should change the signature of this to | (defmulti column-info
{:arglists '([query results])}
(fn [query _]
(:type query))) |
(defmethod column-info :default
[{query-type :type, :as query} _]
(throw (ex-info (tru "Unknown query type {0}" (pr-str query-type))
{:type qp.error-type/invalid-query
:query query}))) | |
+----------------------------------------------------------------------------------------------------------------+ | Adding :cols info for native queries | +----------------------------------------------------------------------------------------------------------------+ | |
Double-check that the driver returned the correct number of | (mu/defn ^:private check-driver-native-columns
[cols :- [:maybe [:sequential [:map-of :any :any]]] rows]
(when (seq rows)
(let [expected-count (count cols)
actual-count (count (first rows))]
(when-not (= expected-count actual-count)
(throw (ex-info (str (deferred-tru "Query processor error: number of columns returned by driver does not match results.")
"\n"
(deferred-tru "Expected {0} columns, but first row of resuls has {1} columns."
expected-count actual-count))
{:expected-columns (map :name cols)
:first-row (first rows)
:type qp.error-type/qp})))))) |
(defn- annotate-native-cols [cols]
(let [unique-name-fn (mbql.u/unique-name-generator)]
(vec (for [{col-name :name, base-type :base_type, :as driver-col-metadata} cols]
(let [col-name (name col-name)]
(merge
{:display_name (u/qualified-name col-name)
:source :native}
;; It is perfectly legal for a driver to return a column with a blank name; for example, SQL Server does
;; this for aggregations like `count(*)` if no alias is used. However, it is *not* legal to use blank
;; names in MBQL `:field` clauses, because `SELECT ` doesn't make any sense. So if we can't return a
;; valid `:field`, omit the `:field_ref`.
(when-not (str/blank? col-name)
{:field_ref [:field (unique-name-fn col-name) {:base-type base-type}]})
driver-col-metadata)))))) | |
(defmethod column-info :native
[_query {:keys [cols rows] :as _results}]
(check-driver-native-columns cols rows)
(annotate-native-cols cols)) | |
+----------------------------------------------------------------------------------------------------------------+ | Adding :cols info for MBQL queries | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn ^:private join-with-alias :- [:maybe mbql.s/Join]
[{:keys [joins source-query]} :- :map
join-alias :- ms/NonBlankString]
(or (some
(fn [{:keys [alias], :as join}]
(when (= alias join-alias)
join))
joins)
(when source-query
(join-with-alias source-query join-alias)))) | |
--------------------------------------------------- Field Info --------------------------------------------------- | |
Return an appropriate display name for a joined field. For explicitly joined Fields, the qualifier is the join alias; for implicitly joined fields, it is the display name of the foreign key used to create the join. | (defn- display-name-for-joined-field
[field-display-name {:keys [fk-field-id], join-alias :alias}]
(let [qualifier (if fk-field-id
;; strip off trailing ` id` from FK display name
(str/replace (:display-name (lib.metadata/field (qp.store/metadata-provider) fk-field-id))
#"(?i)\sid$"
"")
join-alias)]
(format "%s → %s" qualifier field-display-name))) |
Helper for [[infer-expression-type]]. Returns true if a given clause returns a :type/DateTime type. | (defn- datetime-arithmetics?
[clause]
(mbql.match/match-one clause
#{:datetime-add :datetime-subtract :relative-datetime}
true
[:field _ (_ :guard :temporal-unit)]
true
:+
(some (partial mbql.u/is-clause? :interval) (rest clause))
_ false)) |
(declare col-info-for-field-clause) | |
Columns to select from a field to get its type information without getting information that is specific to that column. | (def type-info-columns [:base_type :effective_type :coercion_strategy :semantic_type]) |
Infer base-type/semantic-type information about an | (defn infer-expression-type
[expression]
(cond
(string? expression)
{:base_type :type/Text}
(number? expression)
{:base_type :type/Number}
(mbql.u/is-clause? :field expression)
(col-info-for-field-clause {} expression)
(mbql.u/is-clause? :coalesce expression)
(select-keys (infer-expression-type (second expression)) type-info-columns)
(mbql.u/is-clause? :length expression)
{:base_type :type/BigInteger}
(mbql.u/is-clause? :case expression)
(let [[_ clauses] expression]
(some
(fn [[_ expression]]
;; get the first non-nil val
(when (and (not= expression nil)
(or (not (mbql.u/is-clause? :value expression))
(let [[_ value] expression]
(not= value nil))))
(select-keys (infer-expression-type expression) type-info-columns)))
clauses))
(mbql.u/is-clause? :convert-timezone expression)
{:converted_timezone (nth expression 2)
:base_type :type/DateTime}
(datetime-arithmetics? expression)
;; make sure converted_timezone survived if we do nested datetime operations
;; FIXME: this does not preverse converted_timezone for cases nested expressions
;; i.e:
;; {"expression" {"converted-exp" [:convert-timezone "created-at" "Asia/Ho_Chi_Minh"]
;; "date-add-exp" [:datetime-add [:expression "converted-exp"] 2 :month]}}
;; The converted_timezone metadata added for "converted-exp" will not be brought over
;; to ["date-add-exp"].
;; maybe this `infer-expression-type` should takes an `inner-query` and look up the
;; source expresison as well?
(merge (select-keys (infer-expression-type (second expression)) [:converted_timezone])
{:base_type :type/DateTime})
(mbql.u/is-clause? mbql.s/string-functions expression)
{:base_type :type/Text}
(mbql.u/is-clause? mbql.s/numeric-functions expression)
{:base_type :type/Float}
:else
{:base_type :type/*})) |
(defn- col-info-for-expression
[inner-query [_ expression-name :as clause]]
(merge
(infer-expression-type (mbql.u/expression-with-name inner-query expression-name))
{:name expression-name
:display_name expression-name
;; provided so the FE can add easily add sorts and the like when someone clicks a column header
:expression_name expression-name
:field_ref clause})) | |
(mu/defn ^:private col-info-for-field-clause*
[{:keys [source-metadata source-card-id], :as inner-query} [_ id-or-name opts :as clause] :- mbql.s/field]
(let [join (when (:join-alias opts)
(join-with-alias inner-query (:join-alias opts)))
join-is-at-current-level? (some #(= (:alias %) (:join-alias opts)) (:joins inner-query))
;; record additional information that may have been added by middleware. Sometimes pre-processing middleware
;; needs to add extra info to track things that it did (e.g. the
;; [[metabase.query-processor.middleware.add-dimension-projections]] pre-processing middleware adds keys to
;; track which Fields it adds or needs to remap, and then the post-processing middleware does the actual
;; remapping based on that info)
namespaced-options (not-empty (into {}
(filter (fn [[k _v]]
(and (keyword? k) (namespace k))))
opts))]
;; TODO -- I think we actually need two `:field_ref` columns -- one for referring to the Field at the SAME
;; level, and one for referring to the Field from the PARENT level.
(cond-> {:field_ref (mbql.u/remove-namespaced-options clause)}
(:base-type opts)
(assoc :base_type (:base-type opts))
namespaced-options
(assoc :options namespaced-options)
(string? id-or-name)
(merge (or (some-> (some #(when (= (:name %) id-or-name) %) source-metadata)
(dissoc :field_ref))
{:name id-or-name
:display_name (humanization/name->human-readable-name id-or-name)}))
(integer? id-or-name)
(merge (let [{:keys [parent-id], :as field} (-> (lib.metadata/field (qp.store/metadata-provider) id-or-name)
(dissoc :database-type))]
#_{:clj-kondo/ignore [:deprecated-var]}
(if-not parent-id
(qp.store/->legacy-metadata field)
(let [parent (col-info-for-field-clause inner-query [:field parent-id nil])]
(-> (update field :name #(str (:name parent) \. %))
qp.store/->legacy-metadata)))))
(:binning opts)
(assoc :binning_info (-> (:binning opts)
(set/rename-keys {:strategy :binning-strategy})
u/snake-keys))
(:temporal-unit opts)
(assoc :unit (:temporal-unit opts))
(or (:join-alias opts) (:alias join))
(assoc :source_alias (or (:join-alias opts) (:alias join)))
join
(update :display_name display-name-for-joined-field join)
;; Join with fk-field-id => IMPLICIT JOIN
;; Join w/o fk-field-id => EXPLICIT JOIN
(:fk-field-id join)
(assoc :fk_field_id (:fk-field-id join))
;; For IMPLICIT joins, remove `:join-alias` in the resulting Field ref -- it got added there during
;; preprocessing by us, and wasn't there originally. Make sure the ref has `:source-field`.
(:fk-field-id join)
(update :field_ref mbql.u/update-field-options (fn [opts]
(-> opts
(dissoc :join-alias)
(assoc :source-field (:fk-field-id join)))))
;; If source Field (for an IMPLICIT join) is specified in either the field ref or matching join, make sure we
;; return it as `fk_field_id`. (Not sure what situations it would actually be present in one but not the other
;; -- but it's in the tests :confused:)
(or (:source-field opts)
(:fk-field-id join))
(assoc :fk_field_id (or (:source-field opts)
(:fk-field-id join)))
;; If the source query is from a saved question, remove the join alias as the caller should not be aware of joins
;; happening inside the saved question. The `not join-is-at-current-level?` check is to ensure that we are not
;; removing `:join-alias` from fields from the right side of the join.
(and source-card-id
(not join-is-at-current-level?))
(update :field_ref mbql.u/update-field-options dissoc :join-alias)))) | |
(mu/defn ^:private col-info-for-field-clause :- [:map
[:field_ref mbql.s/Field]]
"Return results column metadata for a `:field` or `:expression` clause, in the format that gets returned by QP results"
[inner-query :- :map
clause :- mbql.s/Field]
(mbql.u/match-one clause
:expression
(col-info-for-expression inner-query &match)
:field
(col-info-for-field-clause* inner-query &match)
;; we should never reach this if our patterns are written right so this is more to catch code mistakes than
;; something the user should expect to see
_
(throw (ex-info (tru "Don''t know how to get information about Field: {0}" &match)
{:field &match})))) | |
(defn- mlv2-query [inner-query]
(qp.store/cached [:mlv2-query (hash inner-query)]
(try
(lib/query
(qp.store/metadata-provider)
(lib.convert/->pMBQL (lib.convert/legacy-query-from-inner-query
(:id (lib.metadata/database (qp.store/metadata-provider)))
(mbql.normalize/normalize-fragment [:query] inner-query))))
(catch Throwable e
(throw (ex-info (tru "Error converting query to pMBQL: {0}" (ex-message e))
{:inner-query inner-query, :type qp.error-type/qp}
e)))))) | |
Return appropriate column metadata for an | (mu/defn ^:private col-info-for-aggregation-clause
;; `clause` is normally an aggregation clause but this function can call itself recursively; see comments by the
;; `match` pattern for field clauses below
[inner-query :- :map
clause]
(let [mlv2-clause (lib.convert/->pMBQL clause)]
;; for some mystery reason it seems like the annotate code uses `:long` style display names when something appears
;; inside an aggregation clause, e.g.
;;
;; Distinct values of Category → Name
;;
;; but `:default` style names when they appear on their own or in breakouts, e.g.
;;
;; Name
;;
;; why is this the case? Who knows! But that's the old pre-MLv2 behavior. I think we should try to fix it, but it's
;; probably going to involve updating a ton of tests that encode the old behavior.
(binding [lib.metadata.calculation/*display-name-style* :long]
(-> (lib/metadata (mlv2-query inner-query) -1 mlv2-clause)
(update-keys u/->snake_case_en)
(dissoc :lib/type))))) |
(mu/defn aggregation-name :- ::lib.schema.common/non-blank-string
"Return an appropriate aggregation name/alias *used inside a query* for an `:aggregation` subclause (an aggregation
or expression). Takes an options map as schema won't support passing keypairs directly as a varargs.
These names are also used directly in queries, e.g. in the equivalent of a SQL `AS` clause."
[inner-query :- [:and
:map
[:fn
{:error/message "legacy inner-query with :source-table or :source-query"}
(some-fn :source-table :source-query)]]
ag-clause]
(lib/column-name (mlv2-query inner-query) (lib.convert/->pMBQL ag-clause))) | |
----------------------------------------- Putting it all together (MBQL) ----------------------------------------- | |
(defn- check-correct-number-of-columns-returned [returned-mbql-columns results]
(let [expected-count (count returned-mbql-columns)
actual-count (count (:cols results))]
(when (seq (:rows results))
(when-not (= expected-count actual-count)
(throw
(ex-info (str (tru "Query processor error: mismatched number of columns in query and results.")
" "
(tru "Expected {0} fields, got {1}" expected-count actual-count)
"\n"
(tru "Expected: {0}" (mapv :name returned-mbql-columns))
"\n"
(tru "Actual: {0}" (vec (:columns results))))
{:expected returned-mbql-columns
:actual (:cols results)})))))) | |
(mu/defn ^:private cols-for-fields
[{:keys [fields], :as inner-query} :- :map]
(for [field fields]
(assoc (col-info-for-field-clause inner-query field)
:source :fields))) | |
(mu/defn ^:private cols-for-ags-and-breakouts
[{aggregations :aggregation, breakouts :breakout, :as inner-query} :- :map]
(concat
(for [breakout breakouts]
(assoc (col-info-for-field-clause inner-query breakout)
:source :breakout))
(for [[i aggregation] (m/indexed aggregations)]
(assoc (col-info-for-aggregation-clause inner-query aggregation)
:source :aggregation
:field_ref [:aggregation i]
:aggregation_index i)))) | |
Return results metadata about the expected columns in an 'inner' MBQL query. | (mu/defn cols-for-mbql-query [inner-query :- :map] (concat (cols-for-ags-and-breakouts inner-query) (cols-for-fields inner-query))) |
(mu/defn ^:private merge-source-metadata-col :- [:maybe :map]
[source-metadata-col :- [:maybe :map]
col :- [:maybe :map]]
(merge
{} ;; ensure the type is not FieldInstance
(when-let [field-id (:id source-metadata-col)]
(-> (lib.metadata/field (qp.store/metadata-provider) field-id)
(dissoc :database-type)
#_{:clj-kondo/ignore [:deprecated-var]}
qp.store/->legacy-metadata))
source-metadata-col
col
;; pass along the unit from the source query metadata if the top-level metadata has unit `:default`. This way the
;; frontend will display the results correctly if bucketing was applied in the nested query, e.g. it will format
;; temporal values in results using that unit
(when (= (:unit col) :default)
(select-keys source-metadata-col [:unit])))) | |
Merge information from | (defn- maybe-merge-source-metadata
[source-metadata cols]
(if (= (count cols) (count source-metadata))
(map merge-source-metadata-col source-metadata cols)
cols)) |
Merge information about fields from | (defn- flow-field-metadata
[source-metadata cols dataset?]
(let [by-key (m/index-by (comp qp.util/field-ref->key :field_ref) source-metadata)]
(for [{:keys [field_ref source] :as col} cols]
;; aggregation fields are not from the source-metadata and their field_ref
;; are not unique for a nested query. So do not merge them otherwise the metadata will be messed up.
;; TODO: I think the best option here is to introduce a parent_field_ref so that
;; we could preserve metadata such as :sematic_type or :unit from the source field.
(if-let [source-metadata-for-field (and (not= :aggregation source)
(get by-key (qp.util/field-ref->key field_ref)))]
(merge-source-metadata-col source-metadata-for-field
(merge col
(when dataset?
(select-keys source-metadata-for-field qp.util/preserved-keys))))
col)))) |
(declare mbql-cols) | |
(defn- cols-for-source-query
[{:keys [source-metadata], {native-source-query :native, :as source-query} :source-query} results]
(let [columns (if native-source-query
(maybe-merge-source-metadata source-metadata (column-info {:type :native} results))
(mbql-cols source-query results))]
(qp.util/combine-metadata columns source-metadata))) | |
Return the | (defn mbql-cols
[{:keys [source-metadata source-query :source-query/dataset? fields], :as inner-query}, results]
(let [cols (cols-for-mbql-query inner-query)]
(cond
(and (empty? cols) source-query)
(cols-for-source-query inner-query results)
source-query
(flow-field-metadata (cols-for-source-query inner-query results) cols dataset?)
(every? #(mbql.u/match-one % [:field (field-name :guard string?) _] field-name) fields)
(maybe-merge-source-metadata source-metadata cols)
:else
cols))) |
(defn- restore-cumulative-aggregations
[{aggregations :aggregation breakouts :breakout :as inner-query} replaced-indices]
(let [offset (count breakouts)
restored (reduce (fn [aggregations index]
(mbql.u/replace-in aggregations [(- index offset)]
[:count] [:cum-count]
[:count field] [:cum-count field]
[:sum field] [:cum-sum field]))
(vec aggregations)
replaced-indices)]
(assoc inner-query :aggregation restored))) | |
(defmethod column-info :query
[{inner-query :query,
replaced-indices :metabase.query-processor.middleware.cumulative-aggregations/replaced-indices}
results]
(u/prog1 (mbql-cols (cond-> inner-query
replaced-indices (restore-cumulative-aggregations replaced-indices))
results)
(check-correct-number-of-columns-returned <> results))) | |
+----------------------------------------------------------------------------------------------------------------+ | Deduplicating names | +----------------------------------------------------------------------------------------------------------------+ | |
(def ^:private ColsWithUniqueNames
[:and
[:maybe [:sequential Col]]
[:fn
{:error/message ":cols with unique names"}
(fn [cols]
(u/empty-or-distinct? (map :name cols)))]]) | |
(mu/defn ^:private deduplicate-cols-names :- ColsWithUniqueNames
[cols :- [:sequential Col]]
(map (fn [col unique-name]
(assoc col :name unique-name))
cols
(mbql.u/uniquify-names (map :name cols)))) | |
+----------------------------------------------------------------------------------------------------------------+ | add-column-info middleware | +----------------------------------------------------------------------------------------------------------------+ | |
Merge a map from | (defn- merge-col-metadata
[our-col-metadata driver-col-metadata]
;; 1. Prefer our `:name` if it's something different that what's returned by the driver
;; (e.g. for named aggregations)
;; 2. Prefer our inferred base type if the driver returned `:type/*` and ours is more specific
;; 3. Then, prefer any non-nil keys returned by the driver
;; 4. Finally, merge in any of our other keys
(let [non-nil-driver-col-metadata (m/filter-vals some? driver-col-metadata)
our-base-type (when (= (:base_type driver-col-metadata) :type/*)
(u/select-non-nil-keys our-col-metadata [:base_type]))
;; whatever type comes back from the query is by definition the effective type, fallback to our effective
;; type, fallback to the base_type
effective-type (when-let [db-base (or (:base_type driver-col-metadata)
(:effective_type our-col-metadata)
(:base_type our-col-metadata))]
{:effective_type db-base})
our-name (u/select-non-nil-keys our-col-metadata [:name])]
(merge our-col-metadata
non-nil-driver-col-metadata
our-base-type
our-name
effective-type))) |
Merge our column metadata ( It's the responsibility of the driver to make sure the | (defn- merge-cols-returned-by-driver
[our-cols cols-returned-by-driver]
(if (seq cols-returned-by-driver)
(mapv merge-col-metadata our-cols cols-returned-by-driver)
our-cols)) |
(mu/defn merged-column-info :- ColsWithUniqueNames
"Returns deduplicated and merged column metadata (`:cols`) for query results by combining (a) the initial results
metadata returned by the driver's impl of `execute-reducible-query` and (b) column metadata inferred by logic in
this namespace."
[query {cols-returned-by-driver :cols, :as result} :- [:maybe :map]]
(deduplicate-cols-names
(merge-cols-returned-by-driver (column-info query result) cols-returned-by-driver))) | |
Native queries don't have the type information from the original | (defn base-type-inferer
[{:keys [cols]}]
(apply fingerprinters/col-wise
(for [{driver-base-type :base_type} cols]
(if (contains? #{nil :type/*} driver-base-type)
(driver.common/values->base-type)
(fingerprinters/constant-fingerprinter driver-base-type))))) |
(defn- add-column-info-xform
[query metadata rf]
(qp.reducible/combine-additional-reducing-fns
rf
[(base-type-inferer metadata)
((take 1) conj)]
(fn combine [result base-types truncated-rows]
(let [metadata (update metadata :cols
(comp annotate-native-cols
(fn [cols]
(map (fn [col base-type]
(-> col
(assoc :base_type base-type)
;; annotate will add a field ref with type info
(dissoc :field_ref)))
cols
base-types))))]
(rf (cond-> result
(map? result)
(assoc-in [:data :cols]
(merged-column-info
query
(assoc metadata :rows truncated-rows))))))))) | |
Middleware for adding type information about the columns in the query results (the | (defn add-column-info
[{query-type :type, :as query
{:keys [:metadata/dataset-metadata :alias/escaped->original]} :info} rff]
(fn add-column-info-rff* [metadata]
(if (and (= query-type :query)
;; we should have type metadata eiter in the query fields
;; or in the result metadata for the following code to work
(or (->> query :query keys (some #{:aggregation :breakout :fields}))
(every? :base_type (:cols metadata))))
(let [query (cond-> query
(seq escaped->original) ;; if we replaced aliases, restore them
(escape-join-aliases/restore-aliases escaped->original))]
(rff (cond-> (assoc metadata :cols (merged-column-info query metadata))
(seq dataset-metadata)
(update :cols qp.util/combine-metadata dataset-metadata))))
;; rows sampling is only needed for native queries! TODO not sure we really even need to do for native
;; queries...
(let [metadata (cond-> (update metadata :cols annotate-native-cols)
;; annotate-native-cols ensures that column refs are present which we need to match metadata
(seq dataset-metadata)
(update :cols qp.util/combine-metadata dataset-metadata)
;; but we want those column refs removed since they have type info which we don't know yet
:always
(update :cols (fn [cols] (map #(dissoc % :field_ref) cols))))]
(add-column-info-xform query metadata (rff metadata)))))) |
Middleware for automatically bucketing unbucketed | (ns metabase.query-processor.middleware.auto-bucket-datetimes (:require [clojure.walk :as walk] [medley.core :as m] [metabase.mbql.predicates :as mbql.preds] [metabase.mbql.schema :as mbql.s] [metabase.mbql.util :as mbql.u] [metabase.query-processor.store :as qp.store] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms])) |
(def ^:private FieldTypeInfo
[:map
[:base-type [:maybe ms/FieldType]]
[:semantic-type {:optional true} [:maybe ms/FieldSemanticOrRelationType]]]) | |
(def ^:private FieldIDOrName->TypeInfo [:map-of [:or ms/NonBlankString ms/PositiveInt] [:maybe FieldTypeInfo]]) | |
Unfortunately these Fields won't be in the store yet since Field resolution can't happen before we add the implicit
TODO - What we could do tho is fetch all the stuff we need for the Store and then save these Fields in the store, which would save a bit of time when we do resolve them | (mu/defn ^:private unbucketed-fields->field-id->type-info :- FieldIDOrName->TypeInfo
"Fetch a map of Field ID -> type information for the Fields referred to by the `unbucketed-fields`."
[unbucketed-fields :- [:sequential {:min 1} mbql.s/field]]
(merge
;; build map of field-literal-name -> {:base-type base-type}
(into {} (for [[_ id-or-name {:keys [base-type]}] unbucketed-fields
:when (string? id-or-name)]
[id-or-name {:base-type base-type}]))
;; build map of field ID -> <info from DB>
(when-let [field-ids (not-empty (into #{}
(comp (map second)
(filter integer?))
unbucketed-fields))]
(into {} (for [{id :id, :as field} (try
(qp.store/bulk-metadata :metadata/column field-ids)
;; don't fail if some of the Fields are invalid.
(catch Throwable e
(log/errorf e "Error fetching Fields: %s" (ex-message e))
nil))]
[id (select-keys field [:base-type :effective-type :semantic-type])]))))) |
(defn- yyyy-MM-dd-date-string? [x]
(and (string? x)
(re-matches #"^\d{4}-\d{2}-\d{2}$" x))) | |
(defn- auto-bucketable-value? [v]
(or (yyyy-MM-dd-date-string? v)
(mbql.u/is-clause? :relative-datetime v))) | |
Is | (defn- should-not-be-autobucketed?
[x]
(or
;; do not autobucket Fields in a non-compound filter clause that either:
(when (and (mbql.preds/Filter? x)
(not (mbql.u/is-clause? #{:and :or :not} x)))
(or
;; * is not an equality or comparison filter. e.g. wouldn't make sense to bucket a field and then check if it is
;; `NOT NULL`
(not (mbql.u/is-clause? #{:= :!= :< :> :<= :>= :between} x))
;; * has arguments that aren't `yyyy-MM-dd` date strings. The only reason we auto-bucket datetime Fields in the
;; * first place is for legacy reasons, if someone is specifying additional info like hour/minute then we
;; * shouldn't assume they want to bucket by day
(let [[_ _ & vs] x]
(not (every? auto-bucketable-value? vs)))))
;; do not auto-bucket fields inside a `:time-interval` filter: it already supplies its own unit
;; do not auto-bucket fields inside a `:datetime-diff` clause: the precise timestamp is needed for the difference
(mbql.u/is-clause? #{:time-interval :datetime-diff} x)
;; do not autobucket Fields that already have a temporal unit, or have a binning strategy
(and (mbql.u/is-clause? :field x)
(let [[_ _ opts] x]
((some-fn :temporal-unit :binning) opts))))) |
(defn- date-or-datetime-field? [{base-type :base-type, effective-type :effective-type}]
(some (fn [field-type]
(some #(isa? field-type %)
[:type/Date :type/DateTime]))
[base-type effective-type])) | |
Add | (mu/defn ^:private wrap-unbucketed-fields
;; we only want to wrap clauses in `:breakout` and `:filter` so just make a 3-arg version of this fn that takes the
;; name of the clause to rewrite and call that twice
([inner-query field-id->type-info :- FieldIDOrName->TypeInfo]
(-> inner-query
(wrap-unbucketed-fields field-id->type-info :breakout)
(wrap-unbucketed-fields field-id->type-info :filter)))
([inner-query field-id->type-info clause-to-rewrite]
(let [datetime-but-not-time? (comp date-or-datetime-field? field-id->type-info)]
(letfn [(wrap-fields [x]
(mbql.u/replace x
;; don't replace anything that's already bucketed or otherwise is not subject to autobucketing
(_ :guard should-not-be-autobucketed?)
&match
;; if it's a `:field` clause and `field-id->type-info` tells us it's a `:type/Temporal` (but not
;; `:type/Time`), then go ahead and replace it
[:field (id-or-name :guard datetime-but-not-time?) opts]
[:field id-or-name (assoc opts :temporal-unit :day)]))]
(m/update-existing inner-query clause-to-rewrite wrap-fields))))) |
(mu/defn ^:private auto-bucket-datetimes-this-level
[{breakouts :breakout, filter-clause :filter, :as inner-query}]
;; find any breakouts or filters in the query that are just plain `[:field-id ...]` clauses (unwrapped by any other
;; clause)
(if-let [unbucketed-fields (mbql.u/match (cons filter-clause breakouts)
(_ :guard should-not-be-autobucketed?) nil
:field &match)]
;; if we found some unbucketed breakouts/filters, fetch the Fields & type info that are referred to by those
;; breakouts/filters...
(let [field-id->type-info (unbucketed-fields->field-id->type-info unbucketed-fields)]
;; ...and then update each breakout/filter by wrapping it if appropriate
(wrap-unbucketed-fields inner-query field-id->type-info))
;; otherwise if there are no unbucketed breakouts/filters return the query as-is
inner-query)) | |
Middleware that automatically adds Applies to any unbucketed Field in a breakout, or fields in a filter clause being compared against | (defn auto-bucket-datetimes
[{query-type :type, :as query}]
(if (not= query-type :query)
query
;; walk query, looking for inner-query forms that have a `:filter` key
(walk/postwalk
(fn [form]
(if (and (map? form)
(or (seq (:filter form))
(seq (:breakout form))))
(auto-bucket-datetimes-this-level form)
form))
query))) |
Middleware that parses filter clause values that come in as strings (e.g. from the API) to the appropriate type. E.g.
a String value in a filter clause against a Note that logic for automatically parsing temporal values lives in the | (ns metabase.query-processor.middleware.auto-parse-filter-values (:require [metabase.mbql.util :as mbql.u] [metabase.query-processor.error-type :as qp.error-type] [metabase.util.i18n :refer [tru]] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms])) |
(set! *warn-on-reflection* true) | |
(mu/defn ^:private parse-value-for-base-type
[v :- :string
base-type :- ms/FieldType]
{:pre [(string? v)]}
(try
(condp #(isa? %2 %1) base-type
:type/BigInteger (bigint v)
:type/Integer (Long/parseLong v)
:type/Decimal (bigdec v)
:type/Float (Double/parseDouble v)
:type/Boolean (Boolean/parseBoolean v)
v)
(catch Throwable e
(throw (ex-info (tru "Error filtering against {0} Field: unable to parse String {1} to a {2}"
base-type
(pr-str v)
base-type)
{:type qp.error-type/invalid-query}
e))))) | |
Automatically parse String filter clause values to the appropriate type. | (defn auto-parse-filter-values
[query]
(mbql.u/replace-in query [:query]
[:value (v :guard string?) (info :guard (fn [{base-type :base_type}]
(and base-type
(not (isa? base-type :type/Text)))))]
[:value (parse-value-for-base-type v (:base_type info)) info])) |
Middleware that handles | (ns metabase.query-processor.middleware.binning (:require [metabase.lib.binning.util :as lib.binning.util] [metabase.lib.card :as lib.card] [metabase.lib.equality :as lib.equality] [metabase.lib.metadata :as lib.metadata] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.id :as lib.schema.id] [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.mbql.schema :as mbql.s] [metabase.mbql.util :as mbql.u] [metabase.query-processor.error-type :as qp.error-type] [metabase.query-processor.store :as qp.store] [metabase.util.i18n :refer [tru]] [metabase.util.malli :as mu])) |
(set! *warn-on-reflection* true) | |
(def ^:private FieldID->Filters [:map-of [:ref ::lib.schema.id/field] [:sequential mbql.s/Filter]]) | |
(mu/defn ^:private filter->field-map :- FieldID->Filters
"Find any comparison or `:between` filter and return a map of referenced Field ID -> all the clauses the reference
it."
[filter-clause :- [:maybe mbql.s/Filter]]
(reduce
(partial merge-with concat)
{}
(for [subclause (mbql.u/match filter-clause #{:between :< :<= :> :>=})
field-id (mbql.u/match subclause [:field (field-id :guard integer?) _] field-id)]
{field-id [subclause]}))) | |
(mu/defn ^:private extract-bounds :- [:map [:min-value number?] [:max-value number?]]
"Given query criteria, find a min/max value for the binning strategy using the greatest user specified min value and
the smallest user specified max value. When a user specified min or max is not found, use the global min/max for the
given field."
[field-id :- [:maybe ::lib.schema.common/positive-int]
fingerprint :- [:maybe :map]
field-id->filters :- FieldID->Filters]
(let [{global-min :min, global-max :max} (get-in fingerprint [:type :type/Number])
filter-clauses (get field-id->filters field-id)
;; [:between <field> <min> <max>] or [:< <field> <x>]
user-maxes (mbql.u/match filter-clauses
[(_ :guard #{:< :<= :between}) & args] (last args))
user-mins (mbql.u/match filter-clauses
[(_ :guard #{:> :>= :between}) _ min-val & _] min-val)
min-value (or (when (seq user-mins)
(apply max user-mins))
global-min)
max-value (or (when (seq user-maxes)
(apply min user-maxes))
global-max)]
(when-not (and min-value max-value)
(throw (ex-info (tru "Unable to bin Field without a min/max value (missing or incomplete fingerprint)")
{:type qp.error-type/invalid-query
:field-id field-id
:fingerprint fingerprint})))
{:min-value min-value, :max-value max-value})) | |
(def ^:private PossiblyLegacyColumnMetadata [:map [:name :string]]) | |
(mu/defn ^:private matching-metadata-from-source-metadata :- ::lib.schema.metadata/column
[field-name :- ::lib.schema.common/non-blank-string
source-metadata :- [:maybe [:sequential PossiblyLegacyColumnMetadata]]]
(do
;; make sure source-metadata exists
(when-not source-metadata
(throw (ex-info (tru "Cannot update binned field: query is missing source-metadata")
{:field field-name})))
;; try to find field in source-metadata with matching name
(let [mlv2-metadatas (for [col source-metadata]
(lib.card/->card-metadata-column (qp.store/metadata-provider) col))]
(or
(lib.equality/find-matching-column
[:field {:lib/uuid (str (random-uuid)), :base-type :type/*} field-name]
mlv2-metadatas)
(throw (ex-info (tru "Cannot update binned field: could not find matching source metadata for Field {0}"
(pr-str field-name))
{:field field-name, :resolved-metadata mlv2-metadatas})))))) | |
(mu/defn ^:private matching-metadata :- ::lib.schema.metadata/column
[field-id-or-name :- [:or ::lib.schema.id/field ::lib.schema.common/non-blank-string]
source-metadata :- [:maybe [:sequential PossiblyLegacyColumnMetadata]]]
(if (integer? field-id-or-name)
;; for Field IDs, just fetch the Field from the Store
(lib.metadata/field (qp.store/metadata-provider) field-id-or-name)
;; for field literals, we require `source-metadata` from the source query
(matching-metadata-from-source-metadata field-id-or-name source-metadata))) | |
(mu/defn ^:private update-binned-field :- mbql.s/field
"Given a `binning-strategy` clause, resolve the binning strategy (either provided or found if default is specified)
and calculate the number of bins and bin width for this field. `field-id->filters` contains related criteria that
could narrow the domain for the field. This info is saved as part of each `binning-strategy` clause."
[{:keys [source-metadata], :as _inner-query}
field-id->filters :- FieldID->Filters
[_ id-or-name {:keys [binning], :as opts}] :- mbql.s/field]
(let [metadata (matching-metadata id-or-name source-metadata)
{:keys [min-value max-value], :as min-max} (extract-bounds (when (integer? id-or-name) id-or-name)
(:fingerprint metadata)
field-id->filters)
[new-strategy resolved-options] (lib.binning.util/resolve-options (qp.store/metadata-provider)
(:strategy binning)
(get binning (:strategy binning))
metadata
min-value max-value)
resolved-options (merge min-max resolved-options)
;; Bail out and use unmodifed version if we can't converge on a nice version.
new-options (or (lib.binning.util/nicer-breakout new-strategy resolved-options)
resolved-options)]
[:field id-or-name (update opts :binning merge {:strategy new-strategy} new-options)])) | |
Update | (defn update-binning-strategy-in-inner-query
[{filters :filter, :as inner-query}]
(let [field-id->filters (filter->field-map filters)]
(mbql.u/replace inner-query
[:field _ (_ :guard :binning)]
(try
(update-binned-field inner-query field-id->filters &match)
(catch Throwable e
(throw (ex-info (.getMessage e) {:clause &match} e))))))) |
When a binned field is found, it might need to be updated if a relevant query criteria affects the min/max value of the binned field. This middleware looks for that criteria, then updates the related min/max values and calculates the bin-width based on the criteria values (or global min/max information). | (defn update-binning-strategy
[{query-type :type, :as query}]
(if (= query-type :native)
query
(update query :query update-binning-strategy-in-inner-query))) |
Middleware that returns cached results for queries when applicable. If caching is enabled ( For all other queries, caching is skipped. The default backend is | (ns metabase.query-processor.middleware.cache (:require [java-time.api :as t] [medley.core :as m] [metabase.config :as config] [metabase.public-settings :as public-settings] [metabase.query-processor.context :as qp.context] [metabase.query-processor.middleware.cache-backend.db :as backend.db] [metabase.query-processor.middleware.cache-backend.interface :as i] [metabase.query-processor.middleware.cache.impl :as impl] [metabase.query-processor.util :as qp.util] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log]) (:import (org.eclipse.jetty.io EofException))) |
(set! *warn-on-reflection* true) | |
(comment backend.db/keep-me) | |
Current serialization format version. Basically [initial-metadata row-1 row-2 ... row-n final-metadata] | (def ^:private cache-version 3) |
Current cache backend. Dynamically rebindable primary for test purposes. | (def ^:dynamic *backend* (i/cache-backend (config/config-kw :mb-qp-cache-backend))) |
------------------------------------------------------ Save ------------------------------------------------------ | |
(defn- purge! [backend]
(try
(log/tracef "Purging cache entries older than %s" (u/format-seconds (public-settings/query-caching-max-ttl)))
(i/purge-old-entries! backend (public-settings/query-caching-max-ttl))
(log/trace "Successfully purged old cache entries.")
:done
(catch Throwable e
(log/error e (trs "Error purging old cache entries: {0}" (ex-message e)))))) | |
Minimum duration it must take a query to complete in order for it to be eligible for caching. | (defn- min-duration-ms [] (* (public-settings/query-caching-min-ttl) 1000)) |
The | (def ^:private ^:dynamic *in-fn* nil) |
Add | (defn- add-object-to-cache!
[object]
(when *in-fn*
(*in-fn* object))) |
The | (def ^:private ^:dynamic *result-fn* nil) |
(defn- serialized-bytes []
(when *result-fn*
(*result-fn*))) | |
Save the final results of a query. | (defn- cache-results!
[query-hash]
(log/info (trs "Caching results for next time for query with hash {0}."
(pr-str (i/short-hex-hash query-hash))) (u/emoji "💾"))
(try
(let [bytez (serialized-bytes)]
(if-not (instance? (Class/forName "[B") bytez)
(log/error (trs "Cannot cache results: expected byte array, got {0}" (class bytez)))
(do
(log/trace "Got serialized bytes; saving to cache backend")
(i/save-results! *backend* query-hash bytez)
(log/debug "Successfully cached results for query.")
(purge! *backend*))))
:done
(catch Throwable e
(if (= (:type (ex-data e)) ::impl/max-bytes)
(log/debug e (trs "Not caching results: results are larger than {0} KB" (public-settings/query-caching-max-kb)))
(log/error e (trs "Error saving query results to cache: {0}" (ex-message e))))))) |
(defn- save-results-xform [start-time metadata query-hash rf]
(let [has-rows? (volatile! false)]
(add-object-to-cache! (assoc metadata
:cache-version cache-version
:last-ran (t/zoned-date-time)))
(fn
([] (rf))
([result]
(add-object-to-cache! (if (map? result)
(m/dissoc-in result [:data :rows])
{}))
(let [duration-ms (- (System/currentTimeMillis) start-time)
eligible? (and @has-rows?
(> duration-ms (min-duration-ms)))]
(log/infof "Query took %s to run; minimum for cache eligibility is %s; %s"
(u/format-milliseconds duration-ms)
(u/format-milliseconds (min-duration-ms))
(if eligible? "eligible" "not eligible"))
(when eligible?
(cache-results! query-hash)))
(rf (cond-> result
(map? result) (assoc-in [:cache/details :hash] query-hash))))
([acc row]
(add-object-to-cache! row)
(vreset! has-rows? true)
(rf acc row))))) | |
----------------------------------------------------- Fetch ------------------------------------------------------ | |
Reducing function for cached results. Merges the final object in the cached results, the | (defn- cached-results-rff
[rff query-hash]
(fn [{:keys [last-ran], :as metadata}]
(let [metadata (dissoc metadata :last-ran :cache-version)
rf (rff metadata)
final-metadata (volatile! nil)]
(fn
([]
(rf))
([result]
(let [normal-format? (and (map? (unreduced result))
(seq (get-in (unreduced result) [:data :cols])))
result* (-> (if normal-format?
(merge-with merge @final-metadata (unreduced result))
(unreduced result))
(assoc :cache/details {:hash query-hash :cached true :updated_at last-ran}))]
(rf (cond-> result*
(reduced? result) reduced))))
([acc row]
(if (map? row)
(vreset! final-metadata row)
(rf acc row))))))) |
Reduces cached results if there is a hit. Otherwise, returns | (defn- maybe-reduce-cached-results
[ignore-cache? query-hash max-age-seconds rff context]
(try
(or (when-not ignore-cache?
(log/tracef "Looking for cached results for query with hash %s younger than %s\n"
(pr-str (i/short-hex-hash query-hash)) (u/format-seconds max-age-seconds))
(i/with-cached-results *backend* query-hash max-age-seconds [is]
(when is
(impl/with-reducible-deserialized-results [[metadata reducible-rows] is]
(log/tracef "Found cached results. Version: %s" (pr-str (:cache-version metadata)))
(when (and (= (:cache-version metadata) cache-version)
reducible-rows)
(log/tracef "Reducing cached rows...")
(qp.context/reducef (cached-results-rff rff query-hash) context metadata reducible-rows)
(log/tracef "All cached rows reduced")
::ok)))))
::miss)
(catch EofException _
(log/debug (trs "Request is closed; no one to return cached results to"))
::canceled)
(catch Throwable e
(log/error e (trs "Error attempting to fetch cached results for query with hash {0}: {1}"
(i/short-hex-hash query-hash) (ex-message e)))
::miss))) |
--------------------------------------------------- Middleware --------------------------------------------------- | |
(defn- run-query-with-cache
[qp {:keys [cache-ttl middleware], :as query} rff {:keys [reducef], :as context}]
;; Query will already have `info.hash` if it's a userland query. It's not the same hash, because this is calculated
;; after normalization, instead of before. This is necessary to make caching work properly with sandboxed users, see
;; #14388.
(let [query-hash (qp.util/query-hash query)
result (maybe-reduce-cached-results (:ignore-cached-results? middleware) query-hash cache-ttl rff context)]
(when (= result ::miss)
(let [start-time-ms (System/currentTimeMillis)]
(log/trace "Running query and saving cached results (if eligible)...")
(let [reducef' (fn [rff context metadata rows]
(impl/do-with-serialization
(fn [in-fn result-fn]
(binding [*in-fn* in-fn
*result-fn* result-fn]
(reducef rff context metadata rows)))))]
(qp query
(fn [metadata]
(save-results-xform start-time-ms metadata query-hash (rff metadata)))
(assoc context :reducef reducef'))))))) | |
(defn- is-cacheable? {:arglists '([query])} [{:keys [cache-ttl]}]
(and (public-settings/enable-query-caching)
cache-ttl)) | |
Middleware for caching results of a query if applicable. In order for a query to be eligible for caching:
| (defn maybe-return-cached-results
[qp]
(fn maybe-return-cached-results* [query rff context]
(let [cacheable? (is-cacheable? query)]
(log/tracef "Query is cacheable? %s" (boolean cacheable?))
(if cacheable?
(run-query-with-cache qp query rff context)
(qp query rff context))))) |
(ns metabase.query-processor.middleware.cache-backend.db
(:require
[java-time.api :as t]
[metabase.db :as mdb]
[metabase.db.query :as mdb.query]
[metabase.models.query-cache :refer [QueryCache]]
[metabase.query-processor.middleware.cache-backend.interface :as i]
[metabase.util.date-2 :as u.date]
[metabase.util.i18n :refer [trs]]
[metabase.util.log :as log]
[toucan2.connection :as t2.connection]
#_{:clj-kondo/ignore [:discouraged-namespace]}
[toucan2.core :as t2])
(:import
(java.sql Connection PreparedStatement ResultSet Types))) | |
(set! *warn-on-reflection* true) | |
(defn- seconds-ago [n]
(let [[unit n] (if-not (integer? n)
[:millisecond (long (* 1000 n))]
[:second n])]
(u.date/add (t/offset-date-time) unit (- n)))) | |
(def ^:private ^{:arglists '([])} cached-results-query-sql
;; this is memoized for a given application DB so we can deliver cached results EXTRA FAST and not have to spend an
;; extra microsecond compiling the same exact query every time. :shrug:
;;
;; Since application DB can change at run time (during tests) it's not just a plain delay
(let [f (memoize (fn [_db-type]
(first (mdb.query/compile {:select [:results]
:from [:query_cache]
:where [:and
[:= :query_hash [:raw "?"]]
[:>= :updated_at [:raw "?"]]]
:order-by [[:updated_at :desc]]
:limit [:inline 1]}))))]
(fn []
(f (mdb/db-type))))) | |
(defn- prepare-statement
^PreparedStatement [^Connection conn query-hash max-age-seconds]
(let [stmt (.prepareStatement conn ^String (cached-results-query-sql)
ResultSet/TYPE_FORWARD_ONLY
ResultSet/CONCUR_READ_ONLY
ResultSet/CLOSE_CURSORS_AT_COMMIT)]
(try
(doto stmt
(.setFetchDirection ResultSet/FETCH_FORWARD)
(.setBytes 1 query-hash)
(.setObject 2 (seconds-ago max-age-seconds) Types/TIMESTAMP_WITH_TIMEZONE)
(.setMaxRows 1))
(catch Throwable e
(log/error e (trs "Error preparing statement to fetch cached query results"))
(.close stmt)
(throw e))))) | |
(defn- cached-results [query-hash max-age-seconds respond]
;; VERY IMPORTANT! Open up a connection (which internally binds [[toucan2.connection/*current-connectable*]] so it
;; will get reused elsewhere for the duration of results reduction, otherwise we can potentially end up deadlocking if
;; we need to acquire another connection for one reason or another, such as recording QueryExecutions
(t2/with-connection [conn]
(with-open [stmt (prepare-statement conn query-hash max-age-seconds)
rs (.executeQuery stmt)]
(assert (= t2.connection/*current-connectable* conn))
(if-not (.next rs)
(respond nil)
(with-open [is (.getBinaryStream rs 1)]
(respond is)))))) | |
Delete any cache entries that are older than the global max age | (defn- purge-old-cache-entries!
[max-age-seconds]
{:pre [(number? max-age-seconds)]}
(log/tracef "Purging old cache entries.")
(try
(t2/delete! (t2/table-name QueryCache)
:updated_at [:<= (seconds-ago max-age-seconds)])
(catch Throwable e
(log/error e (trs "Error purging old cache entries"))))
nil) |
Save the | (defn- save-results!
[^bytes query-hash ^bytes results]
(log/debug (trs "Caching results for query with hash {0}." (pr-str (i/short-hex-hash query-hash))))
(try
(or (pos? (t2/update! QueryCache {:query_hash query-hash}
{:updated_at (t/offset-date-time)
:results results}))
(first (t2/insert-returning-instances! QueryCache
:updated_at (t/offset-date-time)
:query_hash query-hash
:results results)))
(catch Throwable e
(log/error e (trs "Error saving query results to cache."))))
nil) |
(defmethod i/cache-backend :db
[_]
(reify i/CacheBackend
(cached-results [_ query-hash max-age-seconds respond]
(cached-results query-hash max-age-seconds respond))
(save-results! [_ query-hash is]
(save-results! query-hash is)
nil)
(purge-old-entries! [_ max-age-seconds]
(purge-old-cache-entries! max-age-seconds)))) | |
Interface used to define different Query Processor cache backends. To add a new backend, implement See | (ns metabase.query-processor.middleware.cache-backend.interface (:require [buddy.core.codecs :as codecs] [potemkin.types :as p.types])) |
Protocol that different Metabase cache backends must implement. The implementation is responsible for purging old cache entries when appropriate. | (p.types/defprotocol+ CacheBackend
(^{:style/indent 3} cached-results [this ^bytes query-hash max-age-seconds respond]
"Call `respond` with cached results for the query (as an `InputStream` to the raw bytes) if present and not
expired; otherwise, call `respond` with `nil.
(cached-results [_ hash _ respond]
(with-open [is (...)]
(respond is)))
`max-age-seconds` may be floating-point. This method *must* return the result of `respond`.")
(save-results! [this ^bytes query-hash ^bytes results]
"Add a cache entry with the `results` of running query with byte array `query-hash`. This should replace any prior
entries for `query-hash` and update the cache timestamp to the current system time.")
(purge-old-entries! [this max-age-seconds]
"Purge all cache entries older than `max-age-seconds`. Will be called periodically when this backend is in use.
`max-age-seconds` may be floating-point.")) |
Macro version for consuming (with-cached-results backend query-hash max-age-seconds [is] ...) InputStream | (defmacro with-cached-results
{:style/indent 4}
[backend query-hash max-age-seconds [is-binding] & body]
`(cached-results ~backend ~query-hash ~max-age-seconds (fn [~(vary-meta is-binding assoc :tag 'java.io.InputStream)]
~@body))) |
Return an instance of a cache backend, which is any object that implements See | (defmulti cache-backend
{:arglists '([backend-name])}
keyword) |
Util fn. Converts a query hash to a short hex string for logging purposes. | (defn short-hex-hash [^bytes b] (codecs/bytes->hex (byte-array 4 b))) |
(ns metabase.query-processor.middleware.cache.impl
(:require
[flatland.ordered.map :as ordered-map]
[metabase.public-settings :as public-settings]
[metabase.util :as u]
[metabase.util.i18n :refer [trs]]
[metabase.util.log :as log]
[taoensso.nippy :as nippy])
(:import
(java.io BufferedInputStream BufferedOutputStream ByteArrayOutputStream DataInputStream DataOutputStream
EOFException FilterOutputStream InputStream OutputStream)
(java.util.zip GZIPInputStream GZIPOutputStream))) | |
(set! *warn-on-reflection* true) | |
(defn- max-bytes-output-stream ^OutputStream
[max-bytes ^OutputStream os]
(let [byte-count (atom 0)
check-total (fn [current-total]
(when (> current-total max-bytes)
(log/info (trs "Results are too large to cache.") (u/emoji "😫"))
(throw (ex-info (trs "Results are too large to cache.") {:type ::max-bytes}))))]
(proxy [FilterOutputStream] [os]
(write
([x]
(if (int? x)
(do
(check-total (swap! byte-count inc))
(.write os ^int x))
(do
(check-total (swap! byte-count + (alength ^bytes x)))
(.write os ^bytes x))))
([^bytes ba ^Integer off ^Integer len]
(check-total (swap! byte-count + len))
(.write os ba off len)))))) | |
flatland.ordered.map.OrderedMap gets encoded and decoded incorrectly, for some reason. See #25915 | |
(nippy/extend-freeze flatland.ordered.map.OrderedMap :flatland/ordered-map
[x data-output]
(nippy/freeze-to-out! data-output (vec x))) | |
(nippy/extend-thaw :flatland/ordered-map
[data-input]
(ordered-map/ordered-map-reader-clj (nippy/thaw-from-in! data-input))) | |
(defn- freeze! [^OutputStream os obj] (log/tracef "Freezing %s" (pr-str obj)) (nippy/freeze-to-out! os obj) (.flush os)) | |
Create output streams for serializing QP results and invoke (f in-fn result-fn)
When you have serialized all objects, call (do-with-serialization (fn [in result] (doseq [obj objects] (in obj)) (result))) | (defn do-with-serialization
([f]
(do-with-serialization f {:max-bytes (* (public-settings/query-caching-max-kb) 1024)}))
([f {:keys [max-bytes]}]
(with-open [bos (ByteArrayOutputStream.)]
(let [os (-> (max-bytes-output-stream max-bytes bos)
BufferedOutputStream.
(GZIPOutputStream. true)
DataOutputStream.)
error (atom nil)]
(try
(f (fn in* [obj]
(when-not @error
(try
(freeze! os obj)
(catch Throwable e
(log/trace e "Caught error when freezing object")
(reset! error e))))
nil)
(fn result* []
(when @error
(throw @error))
(log/trace "Getting result byte array")
(.toByteArray bos)))
;; this is done manually instead of `with-open` because it might throw an Exception when we close it if it's
;; past the byte limit; that's fine and we can ignore it
(finally
(u/ignore-exceptions (.close os)))))))) |
(defn- thaw!
[^InputStream is]
(try
(nippy/thaw-from-in! is)
(catch EOFException _e
::eof))) | |
(defn- reducible-rows
[^InputStream is]
(reify clojure.lang.IReduceInit
(reduce [_ rf init]
(loop [acc init]
;; NORMALLY we would be checking whether `acc` is `reduced?` here and stop reading from the database if it was,
;; but since we currently store the final metadata at the very end of the database entry as a special pseudo-row
;; we actually have to keep reading the whole thing until we get to that last result. Don't worry, the reducing
;; functions can just throw out everything we don't need. See
;; [[metabase.query-processor.middleware.cache/cache-version]] for a description of our caching format.
(let [row (thaw! is)]
(if (= row ::eof)
acc
(recur (rf acc row)))))))) | |
Impl for [[with-reducible-deserialized-results]]. | (defn do-reducible-deserialized-results
[^InputStream is f]
(with-open [is (DataInputStream. (GZIPInputStream. (BufferedInputStream. is)))]
(let [metadata (thaw! is)]
(if (= metadata ::eof)
(f nil)
(f [metadata (reducible-rows is)]))))) |
Fetches metadata and reducible rows from an InputStream (with-reducible-deserialized-results [[metadata reducible-rows] is] ...)
| (defmacro with-reducible-deserialized-results [[metadata-rows-binding is] & body] `(do-reducible-deserialized-results ~is (fn [~metadata-rows-binding] ~@body))) |
Middleware for catching exceptions thrown by the query processor and returning them in a friendlier format. | (ns metabase.query-processor.middleware.catch-exceptions (:require [metabase.query-processor.context :as qp.context] [metabase.query-processor.error-type :as qp.error-type] [metabase.query-processor.middleware.permissions :as qp.perms] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [schema.utils]) (:import (clojure.lang ExceptionInfo) (java.sql SQLException) (schema.utils NamedError ValidationError))) |
(set! *warn-on-reflection* true) | |
Format an Exception thrown by the Query Processor into a userland error response map. | (defmulti ^:private format-exception
{:arglists '([^Throwable e])}
class) |
(defmethod format-exception Throwable
[^Throwable e]
{:status :failed
:class (class e)
:error (.getMessage e)
:stacktrace (u/filtered-stacktrace e)}) | |
(defmethod format-exception InterruptedException
[^InterruptedException _e]
{:status :interrupted}) | |
Return a nice error message to explain the Schema validation error. TODO - consider moving this into separate middleware as part of a try-catch setup so queries running in a non-userland context can still have sane Exceptions | (defn- explain-schema-validation-error
[error]
(cond
(instance? NamedError error)
(let [nested-error (.error ^NamedError error)]
;; recurse until we find the innermost nested named error, which is the reason
;; we actually failed
(if (instance? NamedError nested-error)
(recur nested-error)
(or (when (map? nested-error)
(explain-schema-validation-error nested-error))
(.name ^NamedError error))))
(map? error)
(first (for [e (vals error)
:when (or (instance? NamedError e)
(instance? ValidationError e))
:let [explanation (explain-schema-validation-error e)]
:when explanation]
explanation))
;; When an exception is thrown, a ValidationError comes back like
;; (throws? ("foreign-keys is not supported by this driver." 10))
;; Extract the message if applicable
(instance? ValidationError error)
(let [explanation (schema.utils/validation-error-explain error)]
(or (when (list? explanation)
(let [[reason [msg]] explanation]
(when (= reason 'throws?)
msg)))
explanation)))) |
(defmethod format-exception ExceptionInfo
[e]
(let [{error :error, error-type :type, :as data} (ex-data e)]
(merge
((get-method format-exception Throwable) e)
(when (= error-type :schema.core/error)
(merge
{:error_type qp.error-type/invalid-query}
(when-let [error-msg (explain-schema-validation-error error)]
{:error error-msg})))
(when (qp.error-type/known-error-type? error-type)
{:error_type error-type})
;; TODO - we should probably change this key to `:data` so we're not mixing lisp-case and snake_case keys
{:ex-data (dissoc data :schema)}))) | |
(defmethod format-exception SQLException
[^SQLException e]
(assoc ((get-method format-exception Throwable) e)
:state (.getSQLState e))) | |
Exception chain in reverse order, e.g. inner-most cause first. TODO -- some of this logic duplicates the functionality of | (defn- exception-chain [e] (reverse (u/full-exception-chain e))) |
In cases where the top-level Exception doesn't have the best error message, return a better one to use instead. We usually want to show SQLExceptions at the top level since they contain more useful information. | (defn- best-top-level-error
[maps]
(some (fn [m]
(when (isa? (:class m) SQLException)
(select-keys m [:error])))
maps)) |
Convert an Exception to a nicely-formatted Clojure map suitable for returning in userland QP responses. | (defn exception-response
[^Throwable e]
(let [[m & more :as maps] (for [e (exception-chain e)]
(format-exception e))]
(merge
m
(best-top-level-error maps)
;; merge in the first error_type we see
(when-let [error-type (some :error_type maps)]
{:error_type error-type})
(when (seq more)
{:via (vec more)})))) |
Map of about | (defn- query-info
[{query-type :type, :as query} {:keys [preprocessed native]}]
(merge
{:json_query (dissoc query :info :driver)}
;; add the fully-preprocessed and native forms to the error message for MBQL queries, since they're extremely
;; useful for debugging purposes.
(when (= (keyword query-type) :query)
{:preprocessed preprocessed
:native (when (qp.perms/current-user-has-adhoc-native-query-perms? query)
native)}))) |
(defn- query-execution-info [query-execution] (dissoc query-execution :result_rows :hash :executor_id :dashboard_id :pulse_id :native :start_time_millis)) | |
Format a | (defn- format-exception*
[query ^Throwable e extra-info]
(try
(if-let [query-execution (:query-execution (ex-data e))]
(merge (query-execution-info query-execution)
(format-exception* query (.getCause e) extra-info))
(merge
{:data {:rows [], :cols []}, :row_count 0}
(exception-response e)
(query-info query extra-info)))
(catch Throwable e
e))) |
Middleware for catching exceptions thrown by the query processor and returning them in a 'normal' format. Forwards
exceptions to the | (defn catch-exceptions
[qp]
(fn [query rff context]
(let [extra-info (delay
{:native (u/ignore-exceptions
((resolve 'metabase.query-processor/compile) query))
:preprocessed (u/ignore-exceptions
((resolve 'metabase.query-processor/preprocess) query))})]
(letfn [(raisef* [e context]
;; format the Exception and return it
(let [formatted-exception (format-exception* query e @extra-info)]
(log/error (str (trs "Error processing query: {0}"
(or (:error formatted-exception)
;; log in server locale, respond in user locale
(trs "Error running query")))
"\n" (u/pprint-to-str formatted-exception)))
;; ensure always a message on the error otherwise FE thinks query was successful. (#23258, #23281)
(qp.context/resultf (update formatted-exception
:error (fnil identity (trs "Error running query")))
context)))]
(try
(qp query rff (assoc context :raisef raisef*))
(catch Throwable e
(raisef* e context))))))) |
(ns metabase.query-processor.middleware.check-features (:require [metabase.driver :as driver] [metabase.lib.metadata :as lib.metadata] [metabase.mbql.schema :as mbql.s] [metabase.mbql.util :as mbql.u] [metabase.query-processor.error-type :as qp.error-type] [metabase.query-processor.store :as qp.store] [metabase.util :as u] [metabase.util.i18n :refer [tru]])) | |
Assert that the driver/database supports keyword | (defn assert-driver-supports
[feature]
(when-not (driver/database-supports? driver/*driver* feature (lib.metadata/database (qp.store/metadata-provider)))
(throw (ex-info (tru "{0} is not supported by this driver." (name feature))
{:type qp.error-type/unsupported-feature
:feature feature})))) |
TODO - definitely a little incomplete. It would be cool if we cool look at the metadata in the schema namespace and auto-generate this logic | (defn- query->required-features [query]
(into
#{}
(mbql.u/match (:query query)
:stddev
:standard-deviation-aggregations
(join :guard (every-pred map? (comp mbql.s/join-strategies :strategy)))
(let [{:keys [strategy]} join]
(assert-driver-supports strategy))))) |
Middleware that checks that drivers support the | (defn check-features
[{query-type :type, :as query}]
(if-not (= query-type :query)
query
(u/prog1 query
(doseq [required-feature (query->required-features query)]
(assert-driver-supports required-feature))))) |
Middleware that adds default constraints to limit the maximum number of rows returned to queries that specify the
| (ns metabase.query-processor.middleware.constraints (:require [metabase.models.setting :as setting] [metabase.util.i18n :refer [deferred-tru]])) |
The following "defaults" are not applied to the settings themselves - why not? Because the existing behavior is
that, if you manually update the settings, queries are affected WHETHER OR NOT the
To achieve this, the QP looks for the following, in order:
1. a non-nil value set by the If we turned the below | (def ^:private ^:const default-unaggregated-query-row-limit 2000) (def ^:private ^:const default-aggregated-query-row-limit 10000) |
NOTE: this was changed from a hardcoded var with value of 2000 (now moved to [[default-unaggregated-query-row-limit]]) to a setting in 0.43 the setting, which allows for DB local value, can still be nil, so any places below that used to reference the former constant value have to expect it could return nil instead | (setting/defsetting unaggregated-query-row-limit (deferred-tru "Maximum number of rows to return specifically on :rows type queries via the API.") :visibility :authenticated :export? true :type :integer :database-local :allowed :audit :getter) |
(setting/defsetting aggregated-query-row-limit (deferred-tru "Maximum number of rows to return for aggregated queries via the API.") :visibility :authenticated :export? true :type :integer :database-local :allowed :audit :getter) | |
Given a query, returns the max rows that should be returned as defined by settings. In other words,
return | (defn query->max-rows
[{{aggregations :aggregation} :query}]
(if-not aggregations
(unaggregated-query-row-limit)
(aggregated-query-row-limit))) |
Default map of constraints that we apply on dataset queries executed by the api. | (defn default-query-constraints
[]
{:max-results (or (aggregated-query-row-limit) default-aggregated-query-row-limit)
:max-results-bare-rows (or (unaggregated-query-row-limit) default-unaggregated-query-row-limit)}) |
Clamps the value of | (defn- ensure-valid-constraints
[{:keys [max-results max-results-bare-rows], :as constraints}]
(if (<= max-results-bare-rows max-results)
constraints
(assoc constraints :max-results-bare-rows max-results))) |
(defn- merge-default-constraints [constraints] (merge (default-query-constraints) constraints)) | |
Add default values of | (defn- add-default-userland-constraints*
[{{:keys [add-default-userland-constraints?]} :middleware, :as query}]
(cond-> query
add-default-userland-constraints? (update :constraints (comp ensure-valid-constraints merge-default-constraints)))) |
Middleware that optionally adds default | (defn add-default-userland-constraints
[qp]
(fn [query rff context]
(qp (add-default-userland-constraints* query) rff context))) |
Middlware for handling cumulative count and cumulative sum aggregations. | (ns metabase.query-processor.middleware.cumulative-aggregations (:require [metabase.mbql.schema :as mbql.s] [metabase.mbql.util :as mbql.u] [metabase.util.malli :as mu])) |
Pre-processing | |
Given two sequential collections, return indecies that are different between the two. | (defn- diff-indices
[coll-1 coll-2]
(into #{}
(keep-indexed (fn [i transformed?]
(when transformed?
i)))
(map not= coll-1 coll-2))) |
(mu/defn ^:private replace-cumulative-ags :- mbql.s/Query
"Replace `cum-count` and `cum-sum` aggregations in `query` with `count` and `sum` aggregations, respectively."
[query]
(mbql.u/replace-in query [:query :aggregation]
;; cumulative count doesn't neccesarily have a field-id arg
[:cum-count] [:count]
[:cum-count field] [:count field]
[:cum-sum field] [:sum field])) | |
Pre-processing middleware. Rewrite | (defn rewrite-cumulative-aggregations
[{{breakouts :breakout, aggregations :aggregation} :query, :as query}]
(if-not (mbql.u/match aggregations #{:cum-count :cum-sum})
query
(let [query' (replace-cumulative-ags query)
;; figure out which indexes are being changed in the results. Since breakouts always get included in
;; results first we need to offset the indexes to change by the number of breakouts
replaced-indices (set (for [i (diff-indices (-> query :query :aggregation)
(-> query' :query :aggregation))]
(+ (count breakouts) i)))]
(cond-> query'
(seq replaced-indices) (assoc ::replaced-indices replaced-indices))))) |
Post-processing | |
Update values in (add-values-from-last-row #{0} [100 200] [50 60]) ; -> [150 60] | (defn- add-values-from-last-row [[index & more] last-row row] (cond (not index) row (not last-row) row :else (recur more last-row (update (vec row) index (partial (fnil + 0 0) (nth last-row index)))))) |
(defn- cumulative-ags-xform [replaced-indices rf]
{:pre [(fn? rf)]}
(let [last-row (volatile! nil)]
(fn
([] (rf))
([result] (rf result))
([result row]
(let [row' (add-values-from-last-row replaced-indices @last-row row)]
(vreset! last-row row')
(rf result row')))))) | |
Post-processing middleware. Sum the cumulative count aggregations that were rewritten by [[rewrite-cumulative-aggregations]] in Clojure-land. | (defn sum-cumulative-aggregation-columns
[{::keys [replaced-indices]} rff]
(if (seq replaced-indices)
(fn sum-cumulative-aggregation-columns-rff* [metadata]
(cumulative-ags-xform replaced-indices (rff metadata)))
rff)) |
(ns metabase.query-processor.middleware.desugar (:require [medley.core :as m] [metabase.mbql.predicates :as mbql.preds] [metabase.mbql.schema :as mbql.s] [metabase.mbql.util :as mbql.u] [metabase.util.malli :as mu])) | |
(mu/defn desugar :- mbql.s/Query
"Middleware that uses MBQL lib functions to replace high-level 'syntactic sugar' clauses like `time-interval` and
`inside` with lower-level clauses like `between`. This is done to minimize the number of MBQL clauses individual
drivers need to support. Clauses replaced by this middleware are marked `^:sugar` in the MBQL schema."
[query]
(m/update-existing query :query (fn [query]
(mbql.u/replace query
(filter-clause :guard mbql.preds/Filter?)
(mbql.u/desugar-filter-clause filter-clause)
(temporal-extract-clause :guard mbql.preds/DatetimeExpression?)
(mbql.u/desugar-temporal-extract temporal-extract-clause)
(expression :guard mbql.preds/FieldOrExpressionDef?)
(mbql.u/desugar-expression expression))))) | |
Wrappers for enterprise-only QP middleware using [[defenterprise]]. Pre-processing and post-processing middleware can use [[defenterprise]] directly, since the top-level function is applied directly each during each QP run, meaning it gets the chance to dispatch correctly every time it is run; 'around' middleware (including 'execution' middleware) needs a helper function that invokes the [[defenterprise]] function during every QP run, rather than just once when all middleware is combined. See [[handle-audit-app-internal-queries]] and [[handle-audit-app-internal-queries-middleware]] for example. | (ns metabase.query-processor.middleware.enterprise (:require [metabase.public-settings.premium-features :refer [defenterprise]] [metabase.query-processor.error-type :as qp.error-type] [metabase.util.i18n :as i18n])) |
Pre-processing middleware | |
(f query) => query | |
Pre-processing middleware. Replaces source tables a User was querying against with source queries that (presumably) restrict the rows returned, based on presence of sandboxes. | (defenterprise apply-sandboxing metabase-enterprise.sandbox.query-processor.middleware.row-level-restrictions [query] query) |
Pre-processing middleware to apply row limits to MBQL export queries if the user has | (defenterprise apply-download-limit metabase-enterprise.advanced-permissions.query-processor.middleware.permissions [query] query) |
Execution middleware | |
(f qp) => qp | |
Middleware for queries that generate downloads, which checks that the user has permissions to download the results of the query, and aborts the query or limits the number of results if necessary. If this query is not run to generate an export (e.g. :export-format is :api) we return user's download permissions in the query metadata so that the frontend can determine whether to show the download option on the UI. | (defenterprise check-download-permissions metabase-enterprise.advanced-permissions.query-processor.middleware.permissions [qp] qp) |
Helper middleware wrapper for [[check-download-permissions]] to make sure we do [[defenterprise]] dispatch correctly on each QP run rather than just once when we combine all of the QP middleware. | (defn check-download-permissions-middleware
[qp]
(fn [query rff context]
((check-download-permissions qp) query rff context))) |
Execution middleware. Check column-level permissions if applicable. | (defenterprise maybe-apply-column-level-perms-check metabase-enterprise.sandbox.query-processor.middleware.column-level-perms-check [qp] qp) |
Helper middleware wrapper for [[maybe-apply-column-level-perms-check]] to make sure we do [[defenterprise]] dispatch correctly on each QP run rather than just once when we combine all of the QP middleware. | (defn maybe-apply-column-level-perms-check-middleware
[qp]
(fn [query rff context]
((maybe-apply-column-level-perms-check qp) query rff context))) |
Post-processing middleware | |
(f query rff) => rff | |
Post-processing middleware to limit the number of rows included in downloads if the user has | (defenterprise limit-download-result-rows metabase-enterprise.advanced-permissions.query-processor.middleware.permissions [_query rff] rff) |
Post-processing middleware. Merges in column metadata from the original, unsandboxed version of the query. | (defenterprise merge-sandboxing-metadata metabase-enterprise.sandbox.query-processor.middleware.row-level-restrictions [_query rff] rff) |
Around middleware | |
(f qp) => qp | |
'Around' middleware that handles | (defenterprise handle-audit-app-internal-queries
metabase-enterprise.audit-app.query-processor.middleware.handle-audit-queries
[qp]
(fn [{query-type :type, :as query} rff context]
(when (= (keyword query-type) :internal)
(throw (ex-info (i18n/tru "Audit App queries are not enabled on this instance.")
{:type qp.error-type/invalid-query})))
(qp query rff context))) |
Helper middleware wrapper for [[handle-audit-app-internal-queries]] to make sure we do [[defenterprise]] dispatch correctly on each QP run rather than just once when we combine all of the QP middleware. | (defn handle-audit-app-internal-queries-middleware
[qp]
(fn [query rff context]
((handle-audit-app-internal-queries qp) query rff context))) |
Deduplicate and escape join aliases. This is done in a series of discrete steps; see the middleware function, [[escape-join-aliases]] for more info. Enable trace logging in this namespace for easier debugging: (metabase.test/set-ns-log-level! 'metabase.query-processor.middleware.escape-join-aliases :trace) | (ns metabase.query-processor.middleware.escape-join-aliases (:require [clojure.set :as set] [metabase.driver :as driver] [metabase.mbql.util :as mbql.u] [metabase.util :as u] [metabase.util.log :as log])) |
this is done in a series of discrete steps | |
(defn- escape-alias [driver join-alias] (driver/escape-alias driver join-alias)) | |
(defn- driver->escape-fn [driver]
(comp (mbql.u/unique-name-generator
;; some databases treat aliases as case-insensitive so make sure the generated aliases
;; are unique regardless of case
:name-key-fn u/lower-case-en
;; uniqified aliases needs to be escaped again just in case
:unique-alias-fn (fn [original suffix]
(escape-alias driver (str original \_ suffix))))
(partial escape-alias driver))) | |
Walk the query and add an | (defn- add-escaped-aliases
[query escape-fn]
(mbql.u/replace query
(join :guard (every-pred map? :condition :alias (complement ::alias)))
(let [join (assoc join ::alias (escape-fn (:alias join)))]
;; now recursively add escaped aliases for `:source-query` etc.
(add-escaped-aliases join escape-fn)))) |
Walk the query and add a map of original alias -> escaped alias at all levels that have either a | (defn- add-original->escaped-alias-maps
[query]
(mbql.u/replace query
(m :guard (every-pred map? (some-fn :source-table :source-query) (complement ::original->escaped)))
(let [original->escaped (into {} (map (juxt :alias ::alias) (:joins m)))
m (assoc m ::original->escaped original->escaped)]
;; now recursively add `::original->escaped` for source query or joins
(add-original->escaped-alias-maps m)))) |
Walk the query and merge the
e.g. when duplicate aliases exist, a join with alias | (defn- merge-original->escaped-maps
[query]
(mbql.u/replace query
(m :guard (every-pred map? ::original->escaped))
;; first, recursively merge all the stuff in the source levels (`:source-query` and `:joins`)
(let [m' (merge-original->escaped-maps (dissoc m ::original->escaped))
;; once things are recursively merged we can collect all the ones that are visible to this level into a
;; sequence of maps. For :source-query:
source-query-original->escaped-map (get-in m' [:source-query ::original->escaped])
;; For :joins:
joins-original->escaped-maps (keep ::original->escaped (:joins m'))
;; ...and then merge them together into one merged map.
merged-original->escaped (reduce (fn [m1 m2]
(merge m2 m1))
(::original->escaped m)
(filter some?
(cons
source-query-original->escaped-map
joins-original->escaped-maps)))]
;; now merge in the `merged-original->escaped` map into our immediate joins, so they are available in the
;; conditions.
(cond-> (assoc m' ::original->escaped merged-original->escaped)
(seq (:joins m')) (update :joins (fn [joins]
(mapv (fn [join]
(update join ::original->escaped merge merged-original->escaped))
joins))))))) |
Walk the query and add an | (defn- add-escaped-join-aliases-to-fields
[query]
(mbql.u/replace query
(m :guard (every-pred map? ::original->escaped))
(let [original->escaped (::original->escaped m)
;; recursively update source levels *first*
m' (assoc (add-escaped-join-aliases-to-fields (dissoc m ::original->escaped))
::original->escaped original->escaped)]
;; now update any `:field` clauses that don't have an `::join-alias`
(mbql.u/replace m'
[:field id-or-name (field-options :guard (every-pred map? :join-alias (complement ::join-alias)))]
[:field id-or-name (assoc field-options ::join-alias (get original->escaped (:join-alias field-options)))])))) |
Build a map of escaped alias -> original alias for the query (current level and all nested levels). Remove keys where
the original alias is identical to the escaped alias; that's not useful information to include in | (defn- merged-escaped->original-with-no-ops-removed
[query]
(let [escaped->original-maps (mbql.u/match query
(m :guard (every-pred map? ::original->escaped))
(merge
(set/map-invert (::original->escaped m))
(merged-escaped->original-with-no-ops-removed (dissoc m ::original->escaped))))]
(not-empty
(into {}
(comp cat
(remove (fn [[k v]]
(= k v))))
escaped->original-maps)))) |
Add a map of escaped alias -> original alias under | (defn- add-escaped->original-info
[query]
(let [escaped->original (not-empty (merged-escaped->original-with-no-ops-removed query))]
(cond-> query
escaped->original (assoc-in [:info :alias/escaped->original] escaped->original)))) |
'Commit' all the new escaped aliases we determined we should use to the query, and clean up all the keys we added in the process of determining this information.
You might be asking, why don't we just do this in the first place rather than adding all these extra keys that we
eventually remove? For joins, we need to track the original alias for a while to build the | (defn- replace-original-aliases-with-escaped-aliases
[query]
(mbql.u/replace query
;; update inner queries that have `::original->escaped` maps
(m :guard (every-pred map? ::original->escaped))
(-> (dissoc m ::original->escaped)
;; recursively update source levels and `:field` clauses.
replace-original-aliases-with-escaped-aliases)
;; update joins
(m :guard (every-pred map? ::alias))
(-> m
(assoc :alias (::alias m))
(dissoc ::alias)
;; recursively update source levels and `:field` clauses.
replace-original-aliases-with-escaped-aliases)
;; update `:field` clauses
[:field id-or-name (options :guard (every-pred map? ::join-alias))]
[:field id-or-name (-> options
(assoc :join-alias (::join-alias options))
(dissoc ::join-alias))])) |
Pre-processing middleware. Make sure all join aliases are unique, regardless of case (some databases treat table aliases as case-insensitive, even if table names themselves are not); escape all join aliases with [[metabase.driver/escape-alias]]. If aliases are 'uniquified', will include a map at [:info :alias/escaped->original] of the escaped name back to the original, to be restored in post processing. | (defn escape-join-aliases
[query]
;; add logging around the steps to make this easier to debug.
(log/debugf "Escaping join aliases\n%s" (u/pprint-to-str query))
(letfn [(add-escaped-aliases* [query]
(add-escaped-aliases query (driver->escape-fn driver/*driver*)))
(add-original->escaped-alias-maps* [query]
(log/tracef "Adding ::alias to joins\n%s" (u/pprint-to-str query))
(add-original->escaped-alias-maps query))
(merge-original->escaped-maps* [query]
(log/tracef "Adding ::original->escaped alias maps\n%s" (u/pprint-to-str query))
(merge-original->escaped-maps query))
(add-escaped-join-aliases-to-fields* [query]
(log/tracef "Adding ::join-alias to :field clauses with :join-alias\n%s" (u/pprint-to-str query))
(add-escaped-join-aliases-to-fields query))
(add-escaped->original-info* [query]
(log/tracef "Adding [:info :alias/escaped->original]\n%s" (u/pprint-to-str query))
(add-escaped->original-info query))
(replace-original-aliases-with-escaped-aliases* [query]
(log/tracef "Replacing original aliases with escaped aliases\n%s" (u/pprint-to-str query))
(replace-original-aliases-with-escaped-aliases query))]
(let [result (if-not (:query query)
;; nothing to do if this is a native query rather than MBQL.
query
(-> query
(update :query (fn [inner-query]
(-> inner-query
add-escaped-aliases*
add-original->escaped-alias-maps*
merge-original->escaped-maps*
add-escaped-join-aliases-to-fields*)))
add-escaped->original-info*
(update :query replace-original-aliases-with-escaped-aliases*)))]
(log/debugf "=>\n%s" (u/pprint-to-str result))
result))) |
The stuff below is used by the [[metabase.query-processor.middleware.annotate]] middleware when generating results metadata to restore the escaped aliases back to what they were in the original query so things don't break if you try to take stuff like the field refs and manipulate the original query with them. | |
Rename joins in | (defn- rename-join-aliases
[query original->new]
(let [original->new (into {} (remove (fn [[original-alias escaped-alias]] (= original-alias escaped-alias))
original->new))
aliases-to-replace (set (keys original->new))]
(if (empty? original->new)
query
(do
(log/tracef "Rewriting join aliases:\n%s" (u/pprint-to-str original->new))
(letfn [(rename-join-aliases* [query]
(mbql.u/replace query
[:field id-or-name (opts :guard (comp aliases-to-replace :join-alias))]
[:field id-or-name (update opts :join-alias original->new)]
(join :guard (every-pred map? :condition (comp aliases-to-replace :alias)))
(merge
;; recursively update stuff inside the join
(rename-join-aliases* (dissoc join :alias))
{:alias (original->new (:alias join))})))]
(rename-join-aliases* query)))))) |
Restore aliases in query.
If aliases were changed in [[escape-join-aliases]], there is a key in | (defn restore-aliases [query escaped->original] (rename-join-aliases query escaped->original)) |
Middleware for expanding ( TODO - this namespace is ancient and written with MBQL '95 in mind, e.g. it is case-sensitive. At some point this ought to be reworked to be case-insensitive and cleaned up. | (ns metabase.query-processor.middleware.expand-macros (:require [malli.core :as mc] [malli.error :as me] [metabase.mbql.schema :as mbql.s] [metabase.mbql.schema.helpers :as helpers] [metabase.mbql.util :as mbql.u] [metabase.query-processor.error-type :as qp.error-type] [metabase.query-processor.store :as qp.store] [metabase.util.i18n :refer [trs tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms])) |
+----------------------------------------------------------------------------------------------------------------+ | SEGMENTS | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- segment-clauses->id->definition [segment-clauses]
(when-let [segment-ids (not-empty (into #{}
(comp (map second)
(filter integer?))
segment-clauses))]
(into {}
(map (juxt :id :definition))
(qp.store/bulk-metadata :metadata/segment segment-ids)))) | |
(defn- replace-segment-clauses [outer-query segment-id->definition]
(mbql.u/replace-in outer-query [:query]
[:segment (segment-id :guard (complement mbql.u/ga-id?))]
(or (:filter (segment-id->definition segment-id))
(throw (IllegalArgumentException. (tru "Segment {0} does not exist, or is invalid." segment-id)))))) | |
(mu/defn ^:private expand-segments :- mbql.s/Query
"Recursively expand segments in the `query`."
[query :- mbql.s/Query]
(loop [{inner-query :query :as outer-query} query
depth 0]
(if-let [segments (mbql.u/match inner-query [:segment (_ :guard (complement mbql.u/ga-id?))])]
(let [segment-id->definition (segment-clauses->id->definition segments)
expanded-query (replace-segment-clauses outer-query segment-id->definition)]
;; Following line is in place to avoid infinite recursion caused by mutually recursive
;; segment definitions or other unforseen circumstances. Number 41 is arbitrary.
(if (or (= expanded-query outer-query) (= depth 41))
(throw (ex-info (tru "Segment expansion failed. Check mutually recursive segment definitions.")
{:type qp.error-type/invalid-query
:original-query query
:expanded-query expanded-query
:segment-id->definition segment-id->definition
:depth depth}))
(recur expanded-query (inc depth))))
outer-query))) | |
+----------------------------------------------------------------------------------------------------------------+ | METRICS | +----------------------------------------------------------------------------------------------------------------+ | |
Return a sequence of any (non-GA) | (defn- metrics [query] ;; metrics won't be in a native query but they could be in source-query or aggregation clause (mbql.u/match query [:metric (_ :guard (complement mbql.u/ga-id?))])) |
(def ^:private MetricInfo
[:map
[:id ms/PositiveInt]
[:name ms/NonBlankString]
[:definition [:map
[:aggregation [:tuple mbql.s/Aggregation]]
[:filter {:optional true} [:maybe mbql.s/Filter]]]]]) | |
(defn- metric-info-validation-errors [metric-info] (me/humanize (mc/explain MetricInfo metric-info))) | |
(mu/defn ^:private metric-clauses->id->info :- [:map-of ms/PositiveInt MetricInfo]
[metric-clauses :- [:sequential mbql.s/metric]]
(when-let [metric-ids (not-empty (into #{} (map second) metric-clauses))]
(into {}
(comp (remove (fn [metric]
(when-let [errors (metric-info-validation-errors metric)]
(log/warn (trs "Invalid metric: {0} reason: {1}" metric errors))
errors)))
(map (juxt :id #(select-keys % [:id :name :definition]))))
(qp.store/bulk-metadata :metadata/metric metric-ids)))) | |
(mu/defn ^:private add-metrics-filters-this-level :- mbql.s/MBQLQuery
[inner-query :- mbql.s/MBQLQuery
this-level-metric-id->info :- [:map-of ms/PositiveInt MetricInfo]]
(let [filters (for [{{filter-clause :filter} :definition} (vals this-level-metric-id->info)
:when filter-clause]
filter-clause)]
(reduce mbql.u/add-filter-clause-to-inner-query inner-query filters))) | |
(mu/defn ^:private metric-info->ag-clause :- mbql.s/Aggregation
"Return an appropriate aggregation clause from `metric-info`."
[{{[aggregation] :aggregation} :definition, metric-name :name} :- MetricInfo
{:keys [use-metric-name-as-display-name?]} :- [:map [:use-metric-name-as-display-name? :boolean]]]
(if-not use-metric-name-as-display-name?
aggregation
;; try to give the resulting aggregation the name of the Metric it came from, unless it already has a display
;; name in which case keep that name
(mbql.u/match-one aggregation
[:aggregation-options _ (_ :guard :display-name)]
&match
[:aggregation-options ag options]
[:aggregation-options ag (assoc options :display-name metric-name)]
_
[:aggregation-options &match {:display-name metric-name}]))) | |
(mu/defn ^:private replace-metrics-aggregations-this-level :- mbql.s/MBQLQuery
[inner-query :- mbql.s/MBQLQuery
this-level-metric-id->info :- [:map-of ms/PositiveInt MetricInfo]]
(letfn [(metric [metric-id]
(or (get this-level-metric-id->info metric-id)
(throw (ex-info (tru "Metric {0} does not exist, or is invalid." metric-id)
{:type :invalid-query
:metric metric-id
:query inner-query}))))]
(mbql.u/replace-in inner-query [:aggregation]
;; if metric is wrapped in aggregation options that give it a display name, expand the metric but do not name it
[:aggregation-options [:metric (metric-id :guard (complement mbql.u/ga-id?))] (options :guard :display-name)]
[:aggregation-options
(metric-info->ag-clause (metric metric-id) {:use-metric-name-as-display-name? false})
options]
;; if metric is wrapped in aggregation options that *do not* give it a display name, expand the metric and then
;; merge the options
[:aggregation-options [:metric (metric-id :guard (complement mbql.u/ga-id?))] options]
(let [[_ ag ag-options] (metric-info->ag-clause (metric metric-id) {:use-metric-name-as-display-name? true})]
[:aggregation-options ag (merge ag-options options)])
;; otherwise for unwrapped metrics expand them in-place
[:metric (metric-id :guard (complement mbql.u/ga-id?))]
(metric-info->ag-clause (metric metric-id) {:use-metric-name-as-display-name? true})))) | |
(mu/defn ^:private metric-ids-this-level :- [:maybe [:set ms/PositiveInt]]
[inner-query]
(when (map? inner-query)
(when-let [aggregations (:aggregation inner-query)]
(not-empty
(set
(mbql.u/match aggregations
[:metric (metric-id :guard (complement mbql.u/ga-id?))]
metric-id)))))) | |
(mu/defn ^:private expand-metrics-clauses-this-level :- [:and
mbql.s/MBQLQuery
[:fn
{:error/message "Inner MBQL query with no :metric clauses at this level"}
(complement metric-ids-this-level)]]
[inner-query :- mbql.s/MBQLQuery
metric-id->info :- [:map-of ms/PositiveInt MetricInfo]]
(let [this-level-metric-ids (metric-ids-this-level inner-query)
this-level-metric-id->info (select-keys metric-id->info this-level-metric-ids)]
(-> inner-query
(add-metrics-filters-this-level this-level-metric-id->info)
(replace-metrics-aggregations-this-level this-level-metric-id->info)))) | |
(mu/defn ^:private expand-metrics-clauses :- ms/Map
"Add appropriate `filter` and `aggregation` clauses for a sequence of Metrics.
(expand-metrics-clauses {:query {}} [[:metric 10]])
;; -> {:query {:aggregation [[:count]], :filter [:= [:field-id 10] 20]}}"
[query :- ms/Map metric-id->info :- (helpers/non-empty [:map-of ms/PositiveInt MetricInfo])]
(mbql.u/replace query
(m :guard metric-ids-this-level)
(-> m
;; expand this this level...
(expand-metrics-clauses-this-level metric-id->info)
;; then recursively expand things at any other levels.
(expand-metrics-clauses metric-id->info)))) | |
(mu/defn ^:private expand-metrics :- mbql.s/Query
[query :- mbql.s/Query]
(if-let [metrics (metrics query)]
(expand-metrics-clauses query (metric-clauses->id->info metrics))
query)) | |
+----------------------------------------------------------------------------------------------------------------+ | MIDDLEWARE | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn ^:private expand-metrics-and-segments :- mbql.s/Query
"Expand the macros (`segment`, `metric`) in a `query`."
[query :- mbql.s/Query]
(-> query
expand-metrics
expand-segments)) | |
Middleware that looks for | (defn expand-macros
[{query-type :type, :as query}]
(if-not (= query-type :query)
query
(expand-metrics-and-segments query))) |
Middleware responsible for 'hydrating' the source query for queries that use another query as their source. This middleware looks for MBQL queries like {:source-table "card__1" ; Shorthand for using Card 1 as source query ...} and resolves the referenced source query, transforming the query to look like the following: {:source-query {...} ; Query for Card 1 :source-metadata [...] ; metadata about columns in Card 1 :source-card-id 1 ; Original Card ID ...} This middleware resolves Card ID {:database TODO - consider renaming this namespace to | (ns metabase.query-processor.middleware.fetch-source-query (:require [clojure.set :as set] [medley.core :as m] [metabase.driver.ddl.interface :as ddl.i] [metabase.driver.util :as driver.u] [metabase.lib.convert :as lib.convert] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.protocols :as lib.metadata.protocols] [metabase.lib.schema.id :as lib.schema.id] [metabase.lib.util :as lib.util] [metabase.mbql.normalize :as mbql.normalize] [metabase.mbql.schema :as mbql.s] [metabase.mbql.util :as mbql.u] [metabase.public-settings :as public-settings] [metabase.query-processor.middleware.permissions :as qp.perms] [metabase.query-processor.store :as qp.store] [metabase.query-processor.util.persisted-cache :as qp.persisted] [metabase.util :as u] [metabase.util.i18n :refer [trs tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [weavejester.dependency :as dep])) |
(set! *warn-on-reflection* true) | |
These next two schemas are for validating the intermediate stages of the middleware. We don't need to validate the entire query | (def ^:private SourceQueryAndMetadata
[:map
[:source-query mbql.s/SourceQuery]
[:database mbql.s/DatabaseID]
[:source-metadata [:maybe [:sequential mbql.s/SourceQueryMetadata]]]
[:source-query/dataset? {:optional true} :boolean]
[:persisted-info/native {:optional true} :string]]) |
(def ^:private MapWithResolvedSourceQuery
[:and
[:map
[:database mbql.s/DatabaseID]
[:source-metadata [:maybe [:sequential mbql.s/SourceQueryMetadata]]]
[:source-query mbql.s/SourceQuery]
[:source-card-id ms/PositiveInt]]
[:fn
{:error/message "`:source-table` should be removed"}
(complement :source-table)]]) | |
(defn- query-has-unresolved-card-id-source-tables? [{inner-mbql-query :query}]
(when inner-mbql-query
(mbql.u/match-one inner-mbql-query
(&match :guard (every-pred map? (comp string? :source-table)))))) | |
(defn- query-has-resolved-database-id? [{:keys [database]}]
((every-pred integer? pos?) database)) | |
Schema for a MBQL query where all This schema represents the way the query should look after this middleware finishes preprocessing it. | (def ^:private FullyResolvedQuery
[:and
mbql.s/Query
[:fn
{:error/message "Query where all card__id :source-tables are fully resolved"}
(complement query-has-unresolved-card-id-source-tables?)]
[:fn
{:error/message "Query where source-query virtual `:database` has been replaced with actual Database ID"}
query-has-resolved-database-id?]]) |
+----------------------------------------------------------------------------------------------------------------+ | Resolving card__id -> source query | +----------------------------------------------------------------------------------------------------------------+ | |
Get the query to be run from the card | (defn- source-query
[{dataset-query :dataset-query, card-id :id, :as card}]
(let [dataset-query (cond-> dataset-query
(:lib/type dataset-query) lib.convert/->legacy-MBQL)
{db-id :database
mbql-query :query
{template-tags :template-tags :as native-query} :native} dataset-query]
(or
mbql-query
;; rename `:query` to `:native` because source queries have a slightly different shape
(when-some [native-query (set/rename-keys native-query {:query :native})]
(let [mongo? (= (driver.u/database->driver db-id) :mongo)]
(cond-> native-query
;; MongoDB native queries consist of a collection and a pipelne (query)
mongo? (update :native (fn [pipeline] {:collection (:collection native-query)
:query pipeline}))
(empty? template-tags) (dissoc :template-tags))))
(throw (ex-info (tru "Missing source query in Card {0}" card-id)
{:card card, :dataset-query dataset-query}))))) |
(mu/defn card-id->source-query-and-metadata :- SourceQueryAndMetadata
"Return the source query info for Card with `card-id`. Pass true as the optional second arg `log?` to enable
logging. (The circularity check calls this and will print more than desired)"
([card-id :- ::lib.schema.id/card]
(card-id->source-query-and-metadata card-id false))
([card-id :- ::lib.schema.id/card log? :- :boolean]
(let [;; todo: we need to cache this. We are running this in preprocess, compile, and then again
card (or (lib.metadata/card (qp.store/metadata-provider) card-id)
(throw (ex-info (tru "Card {0} does not exist." card-id)
{:card-id card-id})))
persisted-info (:lib/persisted-info card)
{{database-id :database} :dataset-query
result-metadata :result-metadata
dataset? :dataset} card
persisted? (qp.persisted/can-substitute? card persisted-info)
source-query (source-query card)]
(when (and persisted? log?)
(log/info (trs "Found substitute cached query for card {0} from {1}.{2}"
card-id
(ddl.i/schema-name {:id database-id} (public-settings/site-uuid))
(:table-name persisted-info))))
;; log the query at this point, it's useful for some purposes
(log/debug (trs "Fetched source query from Card {0}:" card-id)
"\n"
(u/pprint-to-str 'yellow source-query))
(cond-> {:source-query (cond-> source-query
;; This will be applied, if still appropriate, by the peristence middleware
persisted?
(assoc :persisted-info/native
(qp.persisted/persisted-info-native-query
(u/the-id (lib.metadata/database (qp.store/metadata-provider)))
persisted-info)))
:database database-id
:source-metadata (seq (map mbql.normalize/normalize-source-metadata result-metadata))}
dataset? (assoc :source-query/dataset? dataset?))))) | |
+----------------------------------------------------------------------------------------------------------------+ | Logic for traversing the query | +----------------------------------------------------------------------------------------------------------------+ | |
Is | (def ^:private ^{:arglists '([x])} map-with-card-id-source-table?
(every-pred
map?
(comp string? :source-table)
(comp (partial re-matches mbql.s/source-table-card-id-regex) :source-table))) |
(mu/defn ^:private resolve-one :- MapWithResolvedSourceQuery
[{:keys [source-table], :as m} :- [:map [:source-table mbql.s/source-table-card-id-regex]]]
(let [card-id (-> source-table lib.util/legacy-string-table-id->card-id)
source-query-and-metadata (-> card-id (card-id->source-query-and-metadata true))]
(merge
(dissoc m :source-table)
;; record the `card-id` we've resolved here. We'll include it in `:info` for permissions purposes later
{:source-card-id card-id}
source-query-and-metadata))) | |
(defn- resolve-all*
[m]
(mbql.u/replace m
map-with-card-id-source-table?
;; if this is a map that has a Card ID `:source-table`, resolve that (replacing it with the appropriate
;; `:source-query`, then recurse and resolve any nested-nested queries that need to be resolved too
(let [resolved (if (public-settings/enable-nested-queries)
(resolve-one &match)
(throw (ex-info (trs "Nested queries are disabled")
{:clause &match})))]
;; wrap the recursive call in a try-catch; if the recursive resolution fails, add context about the
;; resolution that were we in the process of
(try
(resolve-all* resolved)
(catch Throwable e
(throw (ex-info (tru "Error resolving source query")
{:resolving &match, :resolved resolved}
e))))))) | |
Check that there are no circular dependencies among source cards. This is equivalent to finding a topological sort of the dependency graph. https://en.wikipedia.org/wiki/Topological_sorting | (defn- check-for-circular-references
([m]
(check-for-circular-references (dep/graph) m)
m)
([g m]
(transduce (comp (filter map-with-card-id-source-table?)
(map (comp card-id->source-query-and-metadata
lib.util/legacy-string-table-id->card-id
:source-table)))
(fn
([] g)
([g source-query]
(-> g
(dep/depend m source-query)
;; Recursive call will circuit break the moment there's a cycle, so no
;; danger of unbounded recursion.
(check-for-circular-references source-query)))
([g]
;; This will throw if there's a cycle
(dep/topo-sort g)
g))
(tree-seq coll? identity m)))) |
If | (defn- copy-source-query-database-ids
[{:keys [database], :as m}]
(if (and database (not= database lib.schema.id/saved-questions-virtual-database-id))
m
(let [{:keys [query source-query], :as m}
(cond-> m
(:query m) (update :query copy-source-query-database-ids)
(:source-query m) (update :source-query copy-source-query-database-ids))
db-id
(some (fn [{:keys [database]}]
(when (some-> database (not= lib.schema.id/saved-questions-virtual-database-id))
database))
[source-query query])]
(cond-> m
db-id (assoc :database db-id))))) |
Remove | (defn- remove-unneeded-database-ids
[m]
(mbql.u/replace-in m [:query]
(&match :guard (every-pred map? :database (comp integer? :database)))
(recur (dissoc &match :database)))) |
(mu/defn ^:private extract-resolved-card-id :- [:map
[:card-id [:maybe ms/PositiveInt]]
[:query :map]]
"If the ID of the Card we've resolved (`:source-card-id`) was added by a previous step, add it
to `:query` `:info` (so it can be included in the QueryExecution log), then return a map with the resolved
`:card-id` and updated `:query`."
[query :- :map]
(let [card-id (get-in query [:query :source-card-id])]
{:query (cond-> query
card-id (update-in [:info :card-id] #(or % card-id)))
:card-id card-id})) | |
(mu/defn ^:private resolve-all :- [:map
[:card-id [:maybe ms/PositiveInt]]
[:query :map]]
"Recursively replace all Card ID source tables in `query` with resolved `:source-query` and `:source-metadata`. Since
the `:database` is only useful for top-level source queries, we'll remove it from all other levels."
[query :- :map]
;; if a `:source-card-id` is already in the query, remove it, so we don't pull user-supplied input up into `:info`
;; allowing someone to bypass permissions
(-> (m/dissoc-in query [:query :source-card-id])
check-for-circular-references
resolve-all*
copy-source-query-database-ids
remove-unneeded-database-ids
extract-resolved-card-id)) | |
(mu/defn resolve-card-id-source-tables* :- [:map
[:card-id [:maybe ms/PositiveInt]]
[:query FullyResolvedQuery]]
"Resolve `card__n`-style `:source-tables` in `query`."
[{inner-query :query, :as outer-query} :- mbql.s/Query]
(if-not inner-query
;; for non-MBQL queries there's nothing to do since they have nested queries
{:query outer-query, :card-id nil}
;; Otherwise attempt to expand any source queries as needed. Pull the `:database` key up into the top-level if it
;; exists
(resolve-all outer-query))) | |
Middleware that assocs the | (defn resolve-card-id-source-tables
[qp]
(fn [query rff context]
(let [{:keys [query card-id]} (resolve-card-id-source-tables* query)]
(if card-id
(let [dataset? (:dataset (lib.metadata.protocols/card (qp.store/metadata-provider) card-id))]
(binding [qp.perms/*card-id* (or card-id qp.perms/*card-id*)]
(qp query
(fn [metadata]
(rff (cond-> metadata dataset? (assoc :dataset dataset?))))
context)))
(qp query rff context))))) |
(ns metabase.query-processor.middleware.fix-bad-references (:require [clojure.walk :as walk] [metabase.lib.metadata :as lib.metadata] [metabase.mbql.util :as mbql.u] [metabase.query-processor.store :as qp.store] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log])) | |
(defn- find-source-table [{:keys [source-table source-query]}]
(or source-table
(when source-query
(recur source-query)))) | |
(defn- find-join-against-table [{:keys [joins source-query]} table-id]
(or (when source-query
(find-join-against-table source-query table-id))
(some (fn [join]
(when (= (find-source-table join) table-id)
join))
joins))) | |
(defn- table [table-id]
(when table-id
(lib.metadata/table (qp.store/metadata-provider) table-id))) | |
A function to be called on each bad field found by this middleware. Not used except for in tests. | (def ^:dynamic *bad-field-reference-fn* (constantly nil)) |
(defn- fix-bad-references*
([inner-query]
(fix-bad-references* inner-query inner-query (find-source-table inner-query)))
([inner-query form source-table & sources]
(mbql.u/replace form
;; don't replace anything inside source metadata.
(_ :guard (constantly ((set &parents) :source-metadata)))
&match
;; if we have entered a join map and don't have `join-source` info yet, determine that and recurse.
(m :guard (every-pred map?
:condition
(fn [join]
(let [join-source (find-source-table join)]
(not (contains? (set sources) join-source))))))
(apply fix-bad-references* inner-query m source-table (cons (find-source-table m) sources))
;; find Field ID fields whose Table IS NOT the source table (or not directly available in some `[:source-query+
;; :source-table]` path that do not have `:join-alias` info
[:field
(id :guard (every-pred integer? (fn [id]
(let [{:keys [table-id]} (lib.metadata/field (qp.store/metadata-provider) id)]
(not (some (partial = table-id)
(cons source-table sources)))))))
(opts :guard (complement :join-alias))]
(let [{:keys [table-id], :as field} (lib.metadata/field (qp.store/metadata-provider) id)
{join-alias :alias} (find-join-against-table inner-query table-id)]
(log/warn (u/colorize 'yellow (str (trs "Bad :field clause {0} for field {1} at {2}: clause should have a :join-alias."
(pr-str &match)
(pr-str (format "%s.%s"
(:name (table table-id))
(:name field)))
(pr-str &parents))
" "
(if join-alias
(trs "Guessing join {0}" (pr-str join-alias))
(trs "Unable to infer an appropriate join. Query may not work as expected.")))))
(*bad-field-reference-fn* &match)
(if join-alias
[:field id (assoc opts :join-alias join-alias)]
&match))))) | |
Walk This middleware performs a best-effort DWIM transformation, and isn't smart enough to fix every broken query out there. If the query cannot be fixed, this log a warning and move on. See #19612 for more information. | (defn fix-bad-references
[query]
(walk/postwalk
(fn [form]
(if (and (map? form)
((some-fn :source-query :source-table) form)
(not (:condition form)))
(fix-bad-references* form)
form))
query)) |
Middleware that formats the results of a query. Currently, the only thing this does is convert datetime types to ISO-8601 strings in the appropriate timezone. | (ns metabase.query-processor.middleware.format-rows (:require [java-time.api :as t] [metabase.query-processor.timezone :as qp.timezone] [metabase.util.date-2 :as u.date] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log] [potemkin.types :as p.types]) (:import (java.time Instant LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime ZonedDateTime ZoneId))) |
Protocol for determining how QP results of various classes are serialized. Drivers can add implementations to support custom driver types as needed. | (p.types/defprotocol+ FormatValue
(format-value [v ^ZoneId timezone-id]
"Serialize a value in the QP results. You can add impementations for driver-specific types as needed.")) |
(extend-protocol FormatValue
nil
(format-value [_ _]
nil)
Object
(format-value [v _]
v)
LocalTime
(format-value [t timezone-id]
(t/format :iso-offset-time (u.date/with-time-zone-same-instant t timezone-id)))
OffsetTime
(format-value [t timezone-id]
(t/format :iso-offset-time (u.date/with-time-zone-same-instant t timezone-id)))
LocalDate
(format-value [t timezone-id]
(t/format :iso-offset-date-time (u.date/with-time-zone-same-instant t timezone-id)))
LocalDateTime
(format-value [t timezone-id]
(t/format :iso-offset-date-time (u.date/with-time-zone-same-instant t timezone-id)))
;; convert to a ZonedDateTime
Instant
(format-value [t timezone-id]
(format-value (t/zoned-date-time t (t/zone-id "UTC")) timezone-id))
OffsetDateTime
(format-value [t, ^ZoneId timezone-id]
(t/format :iso-offset-date-time (u.date/with-time-zone-same-instant t timezone-id)))
ZonedDateTime
(format-value [t timezone-id]
(t/format :iso-offset-date-time (u.date/with-time-zone-same-instant t timezone-id)))) | |
(defn- format-rows-xform [rf metadata]
{:pre [(fn? rf)]}
(log/debug (tru "Formatting rows with results timezone ID {0}" (qp.timezone/results-timezone-id)))
(let [timezone-id (t/zone-id (qp.timezone/results-timezone-id))
;; a column will have `converted_timezone` metadata if it is the result of `convert-timezone` expression
;; in that case, we'll format the results with the target timezone.
;; Otherwise format it with results-timezone
cols-zone-id (map #(t/zone-id (get % :converted_timezone timezone-id)) (:cols metadata))]
(fn
([]
(rf))
([result]
(rf result))
([result row]
(rf result (mapv format-value row cols-zone-id)))))) | |
Format individual query result values as needed. Ex: format temporal values as ISO-8601 strings w/ timezone offset. | (defn format-rows
[{{:keys [format-rows?] :or {format-rows? true}} :middleware, :as _query} rff]
(if format-rows?
(fn format-rows-rff* [metadata]
(format-rows-xform (rff metadata) metadata))
rff)) |
Middleware for handling conversion of IDs to strings for proper display of large numbers | (ns metabase.query-processor.middleware.large-int-id (:require [metabase.lib.metadata.protocols :as lib.metadata.protocols] [metabase.mbql.util :as mbql.u] [metabase.query-processor.store :as qp.store])) |
(defn- ->string [x]
(when x
(str x))) | |
(defn- result-int->string
[field-indexes rf]
((map (fn [row]
(reduce #(update (vec %1) %2 ->string) row field-indexes)))
rf)) | |
(defn- should-convert-to-string? [field]
(and (or (isa? (:semantic-type field) :type/PK)
(isa? (:semantic-type field) :type/FK))
(or (isa? (:base-type field) :type/Integer)
(isa? (:base-type field) :type/Number)))) | |
(defn- field-indexes [fields]
(not-empty
(keep-indexed
(fn [idx val]
;; TODO -- we could probably fix the rest of #5816 by adding support for
;; `:field` w/ name and removing the PK/FK requirements -- might break
;; the FE client tho.
(when-let [field (mbql.u/match-one val
[:field (field-id :guard integer?) _]
;; TODO -- can't we use the QP store here? Seems like
;; we should be able to, but it doesn't work (not
;; initialized)
(lib.metadata.protocols/field (qp.store/metadata-provider) field-id))]
(when (should-convert-to-string? field)
idx)))
fields))) | |
Converts any ID (:type/PK and :type/FK) in a result to a string to handle a number > 2^51 or < -2^51, the JavaScript float mantissa. This will allow proper display of large numbers, like IDs from services like social media. All ID numbers are converted to avoid the performance penalty of a comparison based on size. NULLs are converted to Clojure nil/JS null. | (defn convert-id-to-string
[{{:keys [js-int-to-string?] :or {js-int-to-string? false}} :middleware, :as query} rff]
;; currently, this excludes `:field` w/ name clauses, aggregations, etc.
;;
;; for a query like below, *no* conversion will occur
;;
;; (mt/mbql-query venues
;; {:source-query {:source-table $$venues
;; :aggregation [[:aggregation-options
;; [:avg $id]
;; {:name "some_generated_name", :display-name "My Cool Ag"}]]
;; :breakout [$price]}})
;;
;; when you run in this fashion, you lose the ability to determine if it's an ID - you get a `:fields` value like:
;;
;; [[:field "PRICE" {:base-type :type/Integer}] [:field "some_generated_name" {:base-type :type/BigInteger}]]
;;
;; so, short of turning all `:type/Integer` derived values into strings, this is the best approximation of a fix
;; that can be accomplished.
(let [rff' (when js-int-to-string?
(when-let [field-indexes (field-indexes (:fields (:query query)))]
(fn [metadata]
(result-int->string field-indexes (rff metadata)))))]
(or rff' rff))) |
Middleware that handles limiting the maximum number of rows returned by a query. | (ns metabase.query-processor.middleware.limit (:require [metabase.mbql.util :as mbql.u] [metabase.query-processor.interface :as qp.i] [metabase.query-processor.middleware.constraints :as qp.constraints] [metabase.query-processor.util :as qp.util])) |
Pre-processing | |
Returns the value of the disable-max-results? option in this query. | (defn disable-max-results? [query] (get-in query [:middleware :disable-max-results?] false)) |
Sets the value of the disable-max-results? option in this query. | (defn disable-max-results [query] (assoc-in query [:middleware :disable-max-results?] true)) |
(defn- add-limit [max-rows {query-type :type, {original-limit :limit}, :query, :as query}]
(cond-> query
(and (= query-type :query)
(qp.util/query-without-aggregations-or-limits? query))
(update :query assoc :limit max-rows, ::original-limit original-limit))) | |
Given a
| (defn determine-query-max-rows
[query]
(when-not (disable-max-results? query)
(or (qp.constraints/query->max-rows query)
(mbql.u/query->max-rows-limit query)
qp.i/absolute-max-results))) |
Pre-processing middleware. Add default | (defn add-default-limit
[query]
(if-let [max-rows (determine-query-max-rows query)]
(add-limit max-rows query)
query)) |
Post-processing | |
(defn- limit-xform [max-rows rf]
{:pre [(fn? rf)]}
;; TODO FIXME: This is sort of a hack, but our old version of this code used to always take the first row no matter
;; what and [[metabase.driver.sqlserver-test/max-results-bare-rows-test]] was written expecting that behavior. I
;; haven't quite worked around how to fix that test yet. When that happens we can change this to
;;
;; ((take max-rows) rf)
;;
;; Background: SQL Server treats a limit of `0` as meaning "unbounded". SQL Server can override
;; [[qp.constraints/max-results-bare-rows]] with a Database-local Setting to fix #9940, where queries with aggregations
;; and expressions could return the wrong results because of limits being applied to subselects. Realistically the
;; overriden limit of `0` should probably only apply to the MBQL query and not to the number of rows we take. But we'd
;; have to break [[determine-query-max-rows]] into two separate things in order to do that. :shrug:
((take (if-not (pos? max-rows) 1 max-rows)) rf)) | |
Post-processing middleware. Limit the maximum number of rows that are returned in post-processing. | (defn limit-result-rows
[query rff]
(let [max-rows (determine-query-max-rows query)]
(fn limit-result-rows-rff* [metadata]
(limit-xform max-rows (rff metadata))))) |
Middleware responsible for converting MBQL queries to native queries (by calling the driver's QP methods) so the query can then be executed. | (ns metabase.query-processor.middleware.mbql-to-native (:require [metabase.driver :as driver] [metabase.util :as u] [metabase.util.log :as log])) |
Return a | (defn query->native-form
[{query-type :type, :as query}]
(if-not (= :query query-type)
(:native query)
(driver/mbql->native driver/*driver* query))) |
Middleware that handles conversion of MBQL queries to native (by calling driver QP methods) so the queries can be executed. For queries that are already native, this function is effectively a no-op. | (defn mbql->native
[qp]
(fn [query rff context]
(let [native-query (query->native-form query)]
(log/trace (u/format-color 'yellow "\nPreprocessed:\n%s" (u/pprint-to-str query)))
(log/trace (u/format-color 'green "Native form: \n%s" (u/pprint-to-str native-query)))
(qp
(assoc query :native native-query)
(fn [metadata]
(rff (assoc metadata :native_form native-query)))
context)))) |
Middleware that converts a query into a normalized, canonical form. | (ns metabase.query-processor.middleware.normalize-query (:require [metabase.lib.convert :as lib.convert] [metabase.lib.core :as lib] [metabase.mbql.normalize :as mbql.normalize] [metabase.query-processor.error-type :as qp.error-type] [metabase.util :as u] [metabase.util.log :as log])) |
(set! *warn-on-reflection* true) | |
(defn- normalize* [query]
(try
(let [query-type (keyword (some #(get query %) [:lib/type "lib/type" :type "type"]))
_ (assert query-type
(format "Invalid query, missing query :type or :lib/type: %s" (pr-str query)))
normalized (case query-type
:mbql/query ; pMBQL pipeline query
(lib.convert/->legacy-MBQL (lib/normalize query))
(:query :native)
(mbql.normalize/normalize query))]
(log/tracef "Normalized query:\n%s\n=>\n%s" (u/pprint-to-str query) (u/pprint-to-str normalized))
normalized)
(catch Throwable e
(throw (ex-info (format "Error normalizing query: %s" (.getMessage e))
{:type qp.error-type/qp
:query query}
e))))) | |
Middleware that converts a query into a normalized, canonical form, including things like converting all identifiers
into standard | (defn normalize
[qp]
(fn [query rff context]
(qp (normalize* query) rff context))) |
Middlware that optimizes equality filter clauses against bucketed temporal fields. See docstring for
| (ns metabase.query-processor.middleware.optimize-temporal-filters (:require [clojure.walk :as walk] [metabase.mbql.util :as mbql.u] [metabase.util :as u] [metabase.util.date-2 :as u.date] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms])) |
(def ^:private optimizable-units
#{:second :minute :hour :day :week :month :quarter :year}) | |
(defn- temporal-unit [field] (mbql.u/match-one field [:field _ (opts :guard :temporal-unit)] (:temporal-unit opts))) | |
(defn- optimizable-field? [field]
(mbql.u/match-one field
[:field _ (_ :guard (comp optimizable-units :temporal-unit))])) | |
(defmulti ^:private can-optimize-filter? mbql.u/dispatch-by-clause-name-or-class) | |
Can | (defn- optimizable-temporal-value?
[temporal-value]
(mbql.u/match-one temporal-value
[:relative-datetime (_ :guard #{0 :current})]
true
[(_ :guard #{:absolute-datetime :relative-datetime}) _ (unit :guard optimizable-units)]
true)) |
Do datetime | (defn- field-and-temporal-value-have-compatible-units?
[field temporal-value]
(mbql.u/match-one temporal-value
[:relative-datetime (_ :guard #{0 :current})]
true
[(_ :guard #{:absolute-datetime :relative-datetime}) _ (unit :guard optimizable-units)]
(= (temporal-unit field) unit))) |
(defmethod can-optimize-filter? :default
[filter-clause]
(mbql.u/match-one filter-clause
[_
(field :guard optimizable-field?)
(temporal-value :guard optimizable-temporal-value?)]
(field-and-temporal-value-have-compatible-units? field temporal-value))) | |
(defmethod can-optimize-filter? :between
[filter-clause]
(mbql.u/match-one filter-clause
[_
(field :guard optimizable-field?)
(temporal-value-1 :guard optimizable-temporal-value?)
(temporal-value-2 :guard optimizable-temporal-value?)]
(and (field-and-temporal-value-have-compatible-units? field temporal-value-1)
(field-and-temporal-value-have-compatible-units? field temporal-value-2)))) | |
(mu/defn ^:private temporal-literal-lower-bound [unit t :- (ms/InstanceOfClass java.time.temporal.Temporal)] (:start (u.date/range t unit))) | |
(mu/defn ^:private temporal-literal-upper-bound [unit t :- (ms/InstanceOfClass java.time.temporal.Temporal)] (:end (u.date/range t unit))) | |
(defn- change-temporal-unit-to-default [field]
(mbql.u/replace field
[:field _ (_ :guard (comp optimizable-units :temporal-unit))]
(mbql.u/update-field-options &match assoc :temporal-unit :default))) | |
Get a clause representing the lower bound that should be used when converting a | (defmulti ^:private temporal-value-lower-bound
{:arglists '([temporal-value-clause temporal-unit])}
mbql.u/dispatch-by-clause-name-or-class) |
Get a clause representing the upper bound that should be used when converting a | (defmulti ^:private temporal-value-upper-bound
{:arglists '([temporal-value-clause temporal-unit])}
mbql.u/dispatch-by-clause-name-or-class) |
(defmethod temporal-value-lower-bound :absolute-datetime [[_ t unit] _] [:absolute-datetime (temporal-literal-lower-bound unit t) :default]) | |
(defmethod temporal-value-upper-bound :absolute-datetime [[_ t unit] _] [:absolute-datetime (temporal-literal-upper-bound unit t) :default]) | |
(defmethod temporal-value-lower-bound :relative-datetime [[_ n unit] temporal-unit] [:relative-datetime (if (= n :current) 0 n) (or unit temporal-unit)]) | |
(defmethod temporal-value-upper-bound :relative-datetime [[_ n unit] temporal-unit] [:relative-datetime (inc (if (= n :current) 0 n)) (or unit temporal-unit)]) | |
Optimize a filter clause against a temporal-bucketed | (defmulti ^:private optimize-filter
{:arglists '([clause])}
mbql.u/dispatch-by-clause-name-or-class) |
(defmethod optimize-filter :=
[[_tag field temporal-value]]
(let [temporal-unit (mbql.u/match-one field [:field _ (opts :guard :temporal-unit)] (:temporal-unit opts))]
(when (field-and-temporal-value-have-compatible-units? field temporal-value)
(let [field' (change-temporal-unit-to-default field)]
[:and
[:>= field' (temporal-value-lower-bound temporal-value temporal-unit)]
[:< field' (temporal-value-upper-bound temporal-value temporal-unit)]])))) | |
(defmethod optimize-filter :!= [filter-clause] (mbql.u/negate-filter-clause ((get-method optimize-filter :=) filter-clause))) | |
(defn- optimize-comparison-filter [optimize-temporal-value-fn [_filter-type field temporal-value] new-filter-type] [new-filter-type (change-temporal-unit-to-default field) (optimize-temporal-value-fn temporal-value (temporal-unit field))]) | |
(defmethod optimize-filter :< [filter-clause] (optimize-comparison-filter temporal-value-lower-bound filter-clause :<)) | |
(defmethod optimize-filter :<= [filter-clause] (optimize-comparison-filter temporal-value-upper-bound filter-clause :<)) | |
(defmethod optimize-filter :> [filter-clause] (optimize-comparison-filter temporal-value-upper-bound filter-clause :>=)) | |
(defmethod optimize-filter :>= [filter-clause] (optimize-comparison-filter temporal-value-lower-bound filter-clause :>=)) | |
(defmethod optimize-filter :between
[[_ field lower-bound upper-bound]]
(let [field' (change-temporal-unit-to-default field)]
[:and
[:>= field' (temporal-value-lower-bound lower-bound (temporal-unit field))]
[:< field' (temporal-value-upper-bound upper-bound (temporal-unit field))]])) | |
(defn- optimize-temporal-filters* [query]
(mbql.u/replace query
(_ :guard (partial mbql.u/is-clause? (set (keys (methods optimize-filter)))))
(or (when (can-optimize-filter? &match)
(u/prog1 (optimize-filter &match)
(if <>
(when-not (= &match <>)
(log/tracef "Optimized filter %s to %s" (pr-str &match) (pr-str <>)))
;; if for some reason `optimize-filter` doesn't return an optimized filter clause, log and error and use
;; the original. `can-optimize-filter?` shouldn't have said we could optimize this filter in the first
;; place
(log/error (trs "Error optimizing temporal filter clause") (pr-str &match)))))
&match))) | |
Middlware that optimizes equality ( [:= [:field 1 {:temporal-unit :month}] [:absolute-datetime #t "2019-09-01" :month]] -> [:and [:>= [:field 1 {:temporal-unit :default}] [:absolute-datetime #t "2019-09-01" :month]] [:< [:field 1 {:temporal-unit :default}] [:absolute-datetime #t "2019-10-01" :month]]] The equivalent SQL, before and after, looks like: -- before SELECT ... WHERE datetrunc('month', myfield) = date_trunc('month', timestamp '2019-09-01 00:00:00') -- after SELECT ... WHERE myfield >= timestamp '2019-09-01 00:00:00' AND myfield < timestamp '2019-10-01 00:00:00' The idea here is that by avoiding casts/extraction/truncation operations, databases will be able to make better use of indexes on these columns. This namespace expects to run after the | (defn optimize-temporal-filters
[{query-type :type, :as query}]
(if (not= query-type :query)
query
;; walk query, looking for inner-query forms that have a `:filter` key
(walk/postwalk
(fn [form]
(if-not (and (map? form) (seq (:filter form)))
form
;; optimize the filters in this inner-query form.
(let [optimized (optimize-temporal-filters* form)]
;; if we did some optimizations, we should flatten/deduplicate the filter clauses afterwards.
(cond-> optimized
(not= optimized form) (update :filter mbql.u/combine-filter-clauses)))))
query))) |
Middleware for substituting parameters in queries. | (ns metabase.query-processor.middleware.parameters (:require [clojure.data :as data] [clojure.set :as set] [medley.core :as m] [metabase.mbql.normalize :as mbql.normalize] [metabase.mbql.schema :as mbql.s] [metabase.mbql.util :as mbql.u] [metabase.query-processor.middleware.parameters.mbql :as qp.mbql] [metabase.query-processor.middleware.parameters.native :as qp.native] [metabase.util :as u] [metabase.util.log :as log] [metabase.util.malli :as mu])) |
(defn- join? [m] (:condition m)) | |
(mu/defn ^:private move-join-condition-to-source-query :- mbql.s/Join
"Joins aren't allowed to have `:filter` clauses, generated by the `expand-mbql-params` function below. Move the filter
clause into the `:source-query`, converting `:source-table` to a source query if needed."
[{:keys [source-table], filter-clause :filter, :as join}]
(if-not filter-clause
join
(if source-table
(-> (assoc join :source-query {:source-table source-table, :filter filter-clause})
(dissoc :source-table :filter))
;; putting parameters in a join that has a `:source-query` is a little wacky (just add them to `:parameters` in
;; the source query itself), but we'll allow it for now
(-> (update-in join [:source-query :filter] mbql.u/combine-filter-clauses filter-clause)
(dissoc :filter))))) | |
(defn- expand-mbql-params [outer-query {:keys [parameters], :as m}]
;; HACK `qp.mbql/expand` assumes it's operating on an outer query so wrap `m` to look like an outer query. TODO
;; - fix `qp.mbql` to operate on abitrary maps instead of only on top-level queries.
(let [wrapped (assoc outer-query :query m)
{expanded :query} (qp.mbql/expand (dissoc wrapped :parameters) parameters)]
(cond-> expanded
(join? m) move-join-condition-to-source-query))) | |
Expand | (defn- expand-one
[outer-query {:keys [source-table source-query parameters], :as m}]
;; HACK - normalization does not yet operate on `:parameters` that aren't at the top level, so double-check that
;; they're normalized properly before proceeding.
(let [m (cond-> m
(seq parameters) (update :parameters (partial mbql.normalize/normalize-fragment [:parameters])))
expanded (if (or source-table source-query)
(expand-mbql-params outer-query m)
(qp.native/expand-inner m))]
(dissoc expanded :parameters :template-tags))) |
Expand all | (defn- expand-all
([outer-query]
(expand-all outer-query outer-query))
([outer-query m]
(mbql.u/replace m
(_ :guard (every-pred map? (some-fn :parameters :template-tags)))
(let [expanded (expand-one outer-query &match)]
;; now recursively expand any remaining maps that contain `:parameters`
(expand-all outer-query expanded))))) |
Move any top-level parameters to the same level (i.e., 'inner query') as the query they affect. | (defn- move-top-level-params-to-inner-query
[{:keys [parameters], query-type :type, :as outer-query}]
{:pre [(#{:query :native} query-type)]}
(cond-> (set/rename-keys outer-query {:parameters :user-parameters})
(seq parameters)
(assoc-in [query-type :parameters] parameters))) |
Expand parameters in the | (defn- expand-parameters [outer-query] (-> outer-query move-top-level-params-to-inner-query expand-all)) |
(mu/defn ^:private substitute-parameters* :- :map
"If any parameters were supplied then substitute them into the query."
[query]
(u/prog1 (expand-parameters query)
(when (not= <> query)
(when-let [diff (second (data/diff query <>))]
(log/tracef "\n\nSubstituted params:\n%s\n" (u/pprint-to-str 'cyan diff)))))) | |
(defn- assoc-db-in-snippet-tag
[db template-tags]
(->> template-tags
(m/map-vals
(fn [v]
(cond-> v
(= (:type v) :snippet) (assoc :database db))))
(into {}))) | |
Assocs the | (defn- hoist-database-for-snippet-tags [query] (u/update-in-if-exists query [:native :template-tags] (partial assoc-db-in-snippet-tag (:database query)))) |
Substitute Dashboard or Card-supplied parameters in a query, replacing the param placeholers with appropriate values
and/or modifiying the query as appropriate. This looks for maps that have the key A SQL query with a param like | (defn substitute-parameters
[query]
(-> query
hoist-database-for-snippet-tags
substitute-parameters*)) |
Code for handling parameter substitution in MBQL queries. | (ns metabase.query-processor.middleware.parameters.mbql (:require [metabase.driver.common.parameters.dates :as params.dates] [metabase.driver.common.parameters.operators :as params.ops] [metabase.lib.convert :as lib.convert] [metabase.lib.core :as lib] [metabase.lib.metadata.protocols :as lib.metadata.protocols] [metabase.mbql.schema :as mbql.s] [metabase.mbql.util :as mbql.u] [metabase.models.params :as params] [metabase.query-processor.store :as qp.store] [metabase.util.malli :as mu])) |
(set! *warn-on-reflection* true) | |
(mu/defn ^:private to-numeric :- number?
"Returns either a double or a long. Possible to use the edn reader but we would then have to worry about biginters
or arbitrary maps/stuff being read. Error messages would be more confusing EOF while reading instead of a more
sensical number format exception."
[s]
(if (re-find #"\." s)
(Double/parseDouble s)
(Long/parseLong s))) | |
(defn- field-type
[field-clause]
(mbql.u/match-one field-clause
[:field (id :guard integer?) _] ((some-fn :effective-type :base-type)
(lib.metadata.protocols/field (qp.store/metadata-provider) id))
[:field (_ :guard string?) opts] (:base-type opts))) | |
(defn- expression-type
[query expression-clause]
(mbql.u/match-one expression-clause
[:expression (expression-name :guard string?)]
(lib/type-of (lib/query (qp.store/metadata-provider) (lib.convert/->pMBQL query))
(lib.convert/->pMBQL &match)))) | |
Convert | (mu/defn ^:private parse-param-value-for-type
[query param-type param-value field-clause :- mbql.s/Field]
(cond
;; for `id` or `category` type params look up the base-type of the Field and see if it's a number or not.
;; If it *is* a number then recursively call this function and parse the param value as a number as appropriate.
(and (#{:id :category} param-type)
(let [base-type (or (field-type field-clause)
(expression-type query field-clause))]
(isa? base-type :type/Number)))
(recur query :number param-value field-clause)
;; no conversion needed if PARAM-TYPE isn't :number or PARAM-VALUE isn't a string
(or (not= param-type :number)
(not (string? param-value)))
param-value
:else
(to-numeric param-value))) |
(mu/defn ^:private build-filter-clause :- [:maybe mbql.s/Filter]
[query {param-type :type, param-value :value, [_ field :as target] :target, :as param}]
(cond
(params.ops/operator? param-type)
(params.ops/to-clause param)
;; multipe values. Recursively handle them all and glue them all together with an OR clause
(sequential? param-value)
(mbql.u/simplify-compound-filter
(vec (cons :or (for [value param-value]
(build-filter-clause query {:type param-type, :value value, :target target})))))
;; single value, date range. Generate appropriate MBQL clause based on date string
(params.dates/date-type? param-type)
(params.dates/date-string->filter
(parse-param-value-for-type query param-type param-value (params/unwrap-field-or-expression-clause field))
field)
;; TODO - We can't tell the difference between a dashboard parameter (convert to an MBQL filter) and a native
;; query template tag parameter without this. There's should be a better, less fragile way to do this. (Not 100%
;; sure why, but this is needed for GTAPs to work.)
(mbql.u/is-clause? :template-tag field)
nil
;; single-value, non-date param. Generate MBQL [= [field <field> nil] <value>] clause
:else
[:=
(params/wrap-field-id-if-needed field)
(parse-param-value-for-type query param-type param-value (params/unwrap-field-or-expression-clause field))])) | |
Expand parameters for MBQL queries in | (defn expand
[query [{:keys [target value default], :as param} & rest]]
(let [param-value (or value default)]
(cond
(not param)
query
(or (not target)
(not param-value))
(recur query rest)
:else
(let [filter-clause (build-filter-clause query (assoc param :value param-value))
query (mbql.u/add-filter-clause query filter-clause)]
(recur query rest))))) |
Param substitution for native queries. The Basics:
Native parameter parsing and substution logic shared by multiple drivers lives in
The different steps of this process, are similar between existing driver implementations, and are as follows:
| (ns metabase.query-processor.middleware.parameters.native (:require [clojure.set :as set] [metabase.driver :as driver] [metabase.lib.metadata :as lib.metadata] [metabase.query-processor.store :as qp.store])) |
Expand parameters inside an inner native | (defn expand-inner
[inner-query]
(if-not (driver/database-supports? driver/*driver* :native-parameters (lib.metadata/database (qp.store/metadata-provider)))
inner-query
;; Totally ridiculous, but top-level native queries use the key `:query` for SQL or equivalent, while native
;; source queries use `:native`. So we need to handle either case.
(let [source-query? (:native inner-query)
substituted-inner-query (driver/substitute-native-parameters driver/*driver*
(set/rename-keys inner-query {:native :query}))]
(cond-> (dissoc substituted-inner-query :parameters :template-tags)
source-query? (set/rename-keys {:query :native}))))) |
Middleware for checking that the current user has permissions to run the current query. | (ns metabase.query-processor.middleware.permissions
(:require
[clojure.set :as set]
[metabase.api.common
:refer [*current-user-id* *current-user-permissions-set*]]
[metabase.config :as config]
[metabase.lib.metadata.protocols :as lib.metadata.protocols]
[metabase.lib.schema.id :as lib.schema.id]
[metabase.models.interface :as mi]
[metabase.models.permissions :as perms]
[metabase.models.query.permissions :as query-perms]
[metabase.plugins.classloader :as classloader]
[metabase.public-settings.premium-features :refer [defenterprise]]
[metabase.query-processor.error-type :as qp.error-type]
[metabase.query-processor.store :as qp.store]
[metabase.query-processor.util.tag-referenced-cards
:as qp.u.tag-referenced-cards]
[metabase.util :as u]
[metabase.util.i18n :refer [tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu])) |
ID of the Card currently being executed, if there is one. Bind this in a Card-execution so we will use Card [Collection] perms checking rather than ad-hoc perms checking. | (def ^:dynamic *card-id* nil) |
Returns an ExceptionInfo instance containing data relevant for a permissions error. | (defn perms-exception
([required-perms]
(perms-exception (tru "You do not have permissions to run this query.") required-perms))
([message required-perms & [additional-ex-data]]
(ex-info message
(merge {:type qp.error-type/missing-required-permissions
:required-permissions required-perms
:actual-permissions @*current-user-permissions-set*
:permissions-error? true}
additional-ex-data)))) |
Assert that block permissions are not in effect for Database for a query that's only allowed to run because of Collection perms; throw an Exception if they are. Otherwise returns a keyword explaining why the check wasn't done, or why it succeeded (this is mostly for test/debug purposes). The query is still allowed to run if the current User has appropriate data permissions from another Group. See the namespace documentation for [[metabase.models.collection]] for more details. Note that this feature is Metabase© Enterprise Edition™ only. Actual implementation is in [[metabase-enterprise.advanced-permissions.models.permissions.block-permissions/check-block-permissions]] if EE code is present. This feature is only enabled if we have a valid Enterprise Edition™ token. | (def ^:private ^{:arglists '([query])} check-block-permissions
(let [dlay (delay
(when config/ee-available?
(classloader/require 'metabase-enterprise.advanced-permissions.models.permissions.block-permissions)
(resolve 'metabase-enterprise.advanced-permissions.models.permissions.block-permissions/check-block-permissions)))]
(fn [query]
(when-let [f @dlay]
(f query))))) |
Check that the current user has permissions to read Card with | (mu/defn ^:private check-card-read-perms
[database-id :- ::lib.schema.id/database
card-id :- ::lib.schema.id/card]
(qp.store/with-metadata-provider database-id
(let [card (or (some-> (lib.metadata.protocols/card (qp.store/metadata-provider) card-id)
(update-keys u/->snake_case_en)
(vary-meta assoc :type :model/Card))
(throw (ex-info (tru "Card {0} does not exist." card-id)
{:type qp.error-type/invalid-query
:card-id card-id})))]
(log/tracef "Required perms to run Card: %s" (pr-str (mi/perms-objects-set card :read)))
(when-not (mi/can-read? card)
(throw (perms-exception (tru "You do not have permissions to view Card {0}." card-id)
(mi/perms-objects-set card :read)
{:card-id *card-id*})))))) |
(declare check-query-permissions*) | |
(defn- required-perms
{:arglists '([outer-query])}
[{{gtap-perms :gtaps} ::perms, :as outer-query}]
(set/difference
(query-perms/perms-set outer-query, :throw-exceptions? true, :already-preprocessed? true)
gtap-perms)) | |
(defn- has-data-perms? [required-perms] (perms/set-has-full-permissions-for-set? @*current-user-permissions-set* required-perms)) | |
(mu/defn ^:private check-ad-hoc-query-perms
[outer-query]
(let [required-perms (required-perms outer-query)]
(when-not (has-data-perms? required-perms)
(throw (perms-exception required-perms))))
;; check perms for any Cards referenced by this query (if it is a native query)
(doseq [{query :dataset-query} (qp.u.tag-referenced-cards/tags-referenced-cards outer-query)]
(check-query-permissions* query))) | |
Used to allow users looking at a dashboard to view (possibly chained) filters. | (def ^:dynamic *param-values-query* false) |
OSS implementation always throws an exception since queries over the audit DB are not permitted. | (defenterprise check-audit-db-permissions
metabase-enterprise.audit-app.permissions
[query]
(throw (ex-info (tru "Querying this database requires the audit-app feature flag")
query))) |
Check that User with | (mu/defn ^:private check-query-permissions*
[{database-id :database, :as outer-query} :- [:map [:database ::lib.schema.id/database]]]
(when *current-user-id*
(log/tracef "Checking query permissions. Current user perms set = %s" (pr-str @*current-user-permissions-set*))
(when (= perms/audit-db-id database-id)
(check-audit-db-permissions outer-query))
(cond
*card-id*
(do
(check-card-read-perms database-id *card-id*)
(when-not (has-data-perms? (required-perms outer-query))
(check-block-permissions outer-query)))
;; set when querying for field values of dashboard filters, which only require
;; collection perms for the dashboard and not ad-hoc query perms
*param-values-query*
(when-not (has-data-perms? (required-perms outer-query))
(check-block-permissions outer-query))
:else
(check-ad-hoc-query-perms outer-query)))) |
Middleware that check that the current user has permissions to run the current query. This only applies if
| (defn check-query-permissions
[qp]
(fn [query rff context]
(check-query-permissions* query)
(qp query rff context))) |
Pre-processing middleware. Removes the | (defn remove-permissions-key [query] (dissoc query ::perms)) |
+----------------------------------------------------------------------------------------------------------------+ | Writeback fns | +----------------------------------------------------------------------------------------------------------------+ | |
Check that User with | (mu/defn check-query-action-permissions*
[{database-id :database, :as outer-query} :- [:map [:database ::lib.schema.id/database]]]
(log/tracef "Checking query permissions. Current user perms set = %s" (pr-str @*current-user-permissions-set*))
(when *card-id*
(check-card-read-perms database-id *card-id*))
(when-not (has-data-perms? (required-perms outer-query))
(check-block-permissions outer-query))) |
Middleware that check that the current user has permissions to run the current query action. | (defn check-query-action-permissions
[qp]
(fn [query rff context]
(check-query-action-permissions* query)
(qp query rff context))) |
+----------------------------------------------------------------------------------------------------------------+ | Non-middleware util fns | +----------------------------------------------------------------------------------------------------------------+ | |
If current user is bound, do they have ad-hoc native query permissions for | (defn current-user-has-adhoc-native-query-perms?
[{database-id :database, :as _query}]
(or
(not *current-user-id*)
(let [required-perms (perms/adhoc-native-query-path database-id)]
(perms/set-has-full-permissions? @*current-user-permissions-set* required-perms)))) |
Check that the current user (if bound) has adhoc native query permissions to run | (defn check-current-user-has-adhoc-native-query-perms
[{database-id :database, :as query}]
(when-not (current-user-has-adhoc-native-query-perms? query)
(throw (perms-exception (perms/adhoc-native-query-path database-id))))) |
(ns metabase.query-processor.middleware.persistence (:require [metabase.mbql.util :as mbql.u] [metabase.query-processor.middleware.permissions :as qp.perms])) | |
Removes persisted information if user is sandboxed.
If permissions are applied to the query (sandboxing) then do not use the cached query. It may be be possible to use the persistence cache with sandboxing at a later date with further work. | (defn substitute-persisted-query
[{::qp.perms/keys [perms] :as query}]
(if perms
(mbql.u/replace query
(x :guard (every-pred map? :persisted-info/native))
(dissoc x :persisted-info/native))
query)) |
(ns metabase.query-processor.middleware.pre-alias-aggregations (:require [metabase.driver :as driver] [metabase.mbql.util :as mbql.u] [metabase.query-processor.middleware.annotate :as annotate])) | |
(defn- ag-name [inner-query ag-clause] (driver/escape-alias driver/*driver* (annotate/aggregation-name inner-query ag-clause))) | |
(defn- pre-alias-and-uniquify [inner-query aggregations]
(mapv
(fn [original-ag updated-ag]
(if (= original-ag updated-ag)
original-ag
(with-meta updated-ag {:auto-generated? true})))
aggregations
(mbql.u/pre-alias-and-uniquify-aggregations (partial ag-name inner-query) aggregations))) | |
Make sure all aggregations have aliases, and all aliases are unique, in an 'inner' MBQL query. | (defn pre-alias-aggregations-in-inner-query
[{:keys [aggregation source-query joins], :as inner-query}]
(cond-> inner-query
(seq aggregation)
(update :aggregation (partial pre-alias-and-uniquify inner-query))
source-query
(update :source-query pre-alias-aggregations-in-inner-query)
joins
(update :joins (partial mapv pre-alias-aggregations-in-inner-query)))) |
Middleware that generates aliases for all aggregations anywhere in a query, and makes sure they're unique. | (defn pre-alias-aggregations
[{query-type :type, :as query}]
(if-not (= query-type :query)
query
(update query :query pre-alias-aggregations-in-inner-query))) |
(ns metabase.query-processor.middleware.prevent-infinite-recursive-preprocesses (:require [metabase.query-processor.error-type :as qp.error-type] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log])) | |
(def ^:private ^:dynamic *preprocessing-level* 1) | |
(def ^:private ^:const max-preprocessing-level 20) | |
QP around-middleware only used for preprocessing queries with [[metabase.query-processor/preprocess]]. Prevent
infinite recursive calls to | (defn prevent-infinite-recursive-preprocesses
[qp]
(fn [query rff context]
(binding [*preprocessing-level* (inc *preprocessing-level*)]
;; record the number of recursive preprocesses taking place to prevent infinite preprocessing loops.
(log/tracef "*preprocessing-level*: %d" *preprocessing-level*)
(when (>= *preprocessing-level* max-preprocessing-level)
(throw (ex-info (str (tru "Infinite loop detected: recursively preprocessed query {0} times."
max-preprocessing-level))
{:type qp.error-type/qp})))
(qp query rff context)))) |
Middleware related to doing extra steps for queries that are ran via API endpoints (i.e., most of them -- as opposed to queries ran internally e.g. as part of the sync process). These include things like saving QueryExecutions and adding query ViewLogs, storing exceptions and formatting the results. | (ns metabase.query-processor.middleware.process-userland-query
(:require
[java-time.api :as t]
[metabase.events :as events]
[metabase.models.query :as query]
[metabase.models.query-execution
:as query-execution
:refer [QueryExecution]]
[metabase.query-processor.util :as qp.util]
[metabase.util.i18n :refer [trs]]
[metabase.util.log :as log]
#_{:clj-kondo/ignore [:discouraged-namespace]}
[toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
(defn- add-running-time [{start-time-ms :start_time_millis, :as query-execution}]
(-> query-execution
(assoc :running_time (when start-time-ms
(- (System/currentTimeMillis) start-time-ms)))
(dissoc :start_time_millis))) | |
+----------------------------------------------------------------------------------------------------------------+ | Save Query Execution | +----------------------------------------------------------------------------------------------------------------+ | |
Save a TODO - I'm not sure whether this should happen async as is currently the case, or should happen synchronously e.g. in the completing arity of the rf Async seems like it makes sense from a performance standpoint, but should we have some sort of shared threadpool for other places where we would want to do async saves (such as results-metadata for Cards?) | (defn- save-query-execution!*
[{query :json_query, query-hash :hash, running-time :running_time, context :context :as query-execution}]
(when-not (:cache_hit query-execution)
(query/save-query-and-update-average-execution-time! query query-hash running-time))
(if-not context
(log/warn (trs "Cannot save QueryExecution, missing :context"))
(t2/insert! QueryExecution (dissoc query-execution :json_query)))) |
Save a | (defn- save-query-execution!
[execution-info]
(let [execution-info (add-running-time execution-info)]
;; 1. Asynchronously save QueryExecution, update query average execution time etc. using the Agent/pooledExecutor
;; pool, which is a fixed pool of size `nthreads + 2`. This way we don't spin up a ton of threads doing unimportant
;; background query execution saving (as `future` would do, which uses an unbounded thread pool by default)
;;
;; 2. This is on purpose! By *not* using `bound-fn` or `future`, any dynamic variables in play when the task is
;; submitted, such as `db/*connection*`, won't be in play when the task is actually executed. That way we won't
;; attempt to use closed DB connections
(.submit clojure.lang.Agent/pooledExecutor ^Runnable (fn []
(log/trace "Saving QueryExecution info")
(try
(save-query-execution!* execution-info)
(catch Throwable e
(log/error e (trs "Error saving query execution info")))))))) |
(defn- save-successful-query-execution! [cache-details is_sandboxed? query-execution result-rows]
(let [qe-map (assoc query-execution
:cache_hit (boolean (:cached cache-details))
:cache_hash (:hash cache-details)
:result_rows result-rows
:is_sandboxed (boolean is_sandboxed?))]
(save-query-execution! qe-map))) | |
(defn- save-failed-query-execution! [query-execution message] (save-query-execution! (assoc query-execution :error (str message)))) | |
+----------------------------------------------------------------------------------------------------------------+ | Middleware | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- success-response [{query-hash :hash, :as query-execution} {cache :cache/details :as result}]
(merge
(-> query-execution
add-running-time
(dissoc :error :hash :executor_id :action_id :is_sandboxed :card_id :dashboard_id :pulse_id :result_rows :native))
(dissoc result :cache/details)
{:cached (boolean (:cached cache))
:status :completed
:average_execution_time (when (:cached cache)
(query/average-execution-time-ms query-hash))})) | |
(defn- add-and-save-execution-info-xform! [execution-info rf]
{:pre [(fn? rf)]}
;; previously we did nothing for cached results, now we have `cache_hit?` column
(let [row-count (volatile! 0)]
(fn execution-info-rf*
([]
(rf))
([acc]
;; We don't actually have a guarantee that it's from a card just because it's userland
(when (integer? (:card_id execution-info))
(events/publish-event! :event/card-query {:user-id (:executor_id execution-info)
:card-id (:card_id execution-info)
:context (:context execution-info)}))
(save-successful-query-execution! (:cache/details acc) (get-in acc [:data :is_sandboxed]) execution-info @row-count)
(rf (if (map? acc)
(success-response execution-info acc)
acc)))
([result row]
(vswap! row-count inc)
(rf result row))))) | |
Return the info for the QueryExecution entry for this | (defn- query-execution-info
{:arglists '([query])}
[{{:keys [executed-by query-hash context action-id card-id dashboard-id pulse-id]} :info
database-id :database
query-type :type
:as query}]
{:pre [(instance? (Class/forName "[B") query-hash)]}
{:database_id database-id
:executor_id executed-by
:action_id action-id
:card_id card-id
:dashboard_id dashboard-id
:pulse_id pulse-id
:context context
:hash query-hash
:native (= (keyword query-type) :native)
:json_query (cond-> (dissoc query :info)
(empty? (:parameters query)) (dissoc :parameters))
:started_at (t/zoned-date-time)
:running_time 0
:result_rows 0
:start_time_millis (System/currentTimeMillis)}) |
Do extra handling 'userland' queries (i.e. ones ran as a result of a user action, e.g. an API call, scheduled Pulse, etc.). This includes recording QueryExecution entries and returning the results in an FE-client-friendly format. | (defn process-userland-query
[qp]
(fn [query rff {:keys [raisef], :as context}]
(let [query (assoc-in query [:info :query-hash] (qp.util/query-hash query))
execution-info (query-execution-info query)]
(letfn [(rff* [metadata]
(add-and-save-execution-info-xform! execution-info (rff metadata)))
(raisef* [^Throwable e context]
(save-failed-query-execution!
execution-info
(or
(some-> e (.getCause) (.getMessage))
(.getMessage e)))
(raisef (ex-info (.getMessage e)
{:query-execution execution-info}
e)
context))]
(try
(qp query rff* (assoc context :raisef raisef*))
(catch Throwable e
(raisef* e context))))))) |
SQL places restrictions when using a Bad: SELECT count(*) FROM table GROUP BY CAST(x AS date) ORDER BY x ASC (MBQL) {:source-table 1 :breakout [[:field 1 {:temporal-unit :day}]] :order-by [[:asc [:field 1 nil]]]} Good: SELECT count(*) FROM table GROUP BY CAST(x AS date) ORDER BY CAST(x AS date) ASC (MBQL) {:source-table 1 :breakout [[:field 1 {:temporal-unit :day}]] :order-by [[:asc [:field 1 {:temporal-unit :day}]]]} The frontend, on the rare occasion it generates a query that explicitly specifies an | (ns metabase.query-processor.middleware.reconcile-breakout-and-order-by-bucketing (:require [metabase.mbql.schema :as mbql.s] [metabase.mbql.util :as mbql.u] [metabase.util.malli :as mu])) |
(mu/defn ^:private reconcile-bucketing :- mbql.s/Query
[{{breakouts :breakout} :query, :as query} :- :map]
;; Look for bucketed fields in the `breakout` clause and build a map of unbucketed reference -> bucketed reference,
;; like:
;;
;; {[:field 1 nil] [:field 1 {:temporal-unit :day}]}
;;
;; In causes where a Field is broken out more than once, prefer the bucketing used by the first breakout; accomplish
;; this by reversing the sequence of matches below, meaning the first match will get merged into the map last,
;; overwriting later matches
(let [unbucketed-ref->bucketed-ref (into {} (reverse (mbql.u/match breakouts
[:field id-or-name opts]
[[:field id-or-name (not-empty (dissoc opts :temporal-unit :binning))]
&match])))]
;; rewrite order-by clauses as needed...
(-> (mbql.u/replace-in query [:query :order-by]
;; if order by is already bucketed, nothing to do
[:field id-or-name (_ :guard (some-fn :temporal-unit :binning))]
&match
;; if we run into a field that wasn't matched by the last pattern, see if there's an unbucketed reference
;; -> bucketed reference from earlier
:field
(if-let [bucketed-reference (unbucketed-ref->bucketed-ref &match)]
;; if there is, replace it with the bucketed reference
bucketed-reference
;; if there's not, again nothing to do.
&match))
;; now remove any duplicate order-by clauses we may have introduced, as those are illegal in MBQL 2000
(update-in [:query :order-by] (comp vec distinct))))) | |
Replace any unbucketed {:query {:breakout [[:field 1 {:temporal-unit :day}]] :order-by [[:asc [:field 1 nil]]]}} -> {:query {:breakout [[:field 1 {:temporal-unit :day}]] :order-by [[:asc [:field 1 {:temporal-unit :day}]]]}} | (defn reconcile-breakout-and-order-by-bucketing
[{{breakouts :breakout, order-bys :order-by} :query, :as query}]
(if (or
;; if there's no breakouts bucketed by a datetime-field or binning-strategy...
(empty? (mbql.u/match breakouts [:field _ (_ :guard (some-fn :temporal-unit :binning))]))
;; or if there's no order-bys that are *not* bucketed...
(empty? (mbql.u/match order-bys
[:field _ (_ :guard (some-fn :temporal-unit :binning))]
nil
:field
&match)))
;; return query as is
query
;; otherwise, time to bucket
(reconcile-bucketing query))) |
(ns metabase.query-processor.middleware.resolve-database-and-driver
(:require
[metabase.driver :as driver]
[metabase.lib.metadata :as lib.metadata]
[metabase.lib.metadata.protocols :as lib.metadata.protocols]
[metabase.lib.schema.id :as lib.schema.id]
[metabase.lib.util :as lib.util]
[metabase.models.setting :as setting]
[metabase.query-processor.error-type :as qp.error-type]
[metabase.query-processor.store :as qp.store]
[metabase.util.i18n :refer [tru]]
[metabase.util.malli :as mu]
#_{:clj-kondo/ignore [:discouraged-namespace]}
[toucan2.core :as t2])) | |
(declare resolve-database-id) | |
(defn- bootstrap-metadata-provider []
(if (qp.store/initialized?)
(qp.store/metadata-provider)
(reify lib.metadata.protocols/MetadataProvider
(card [_this card-id]
(t2/select-one-fn
(fn [card]
{:lib/type :metadata/card
:database-id (:database_id card)})
[:model/Card :database_id]
:id card-id))))) | |
(mu/defn ^:private resolve-database-id-for-source-card :- ::lib.schema.id/database
[source-card-id :- ::lib.schema.id/card]
(let [card (or (lib.metadata.protocols/card (bootstrap-metadata-provider) source-card-id)
(throw (ex-info (tru "Card {0} does not exist." source-card-id)
{:card-id source-card-id, :type qp.error-type/invalid-query, :status-code 404})))]
(:database-id card))) | |
(mu/defn resolve-database-id :- ::lib.schema.id/database
"Return the *actual* `:database` ID for a query, even if it is using
the [[metabase.lib.schema.id/saved-questions-virtual-database-id]]."
[{database-id :database, :as query}]
(or
(when (pos-int? database-id)
database-id)
;; MLv2 query
(when (= (:lib/type query) :mbql/query)
(when-let [source-card-id (lib.util/source-card-id query)]
(resolve-database-id-for-source-card source-card-id)))
;; legacy query
(when (= (:type query) :query)
(let [most-deeply-nested-source-query (last (take-while some? (iterate :source-query (:query query))))]
(when-let [card-id (lib.util/legacy-string-table-id->card-id (:source-table most-deeply-nested-source-query))]
(resolve-database-id-for-source-card card-id)))))) | |
If query | (defn resolve-database
[qp]
(fn [query rff context]
(let [query' (assoc query :database (resolve-database-id query))]
(qp query' rff context)))) |
Middleware that resolves the Database referenced by the query under that | (defn resolve-driver-and-database-local-values
[qp]
(fn [query rff context]
(let [{:keys [settings], driver :engine} (lib.metadata/database (qp.store/metadata-provider))]
;; make sure the driver is initialized.
(try
(driver/the-initialized-driver driver)
(catch Throwable e
(throw (ex-info (tru "Unable to resolve driver for query")
{:type qp.error-type/invalid-query}
e))))
(binding [setting/*database-local-values* settings]
(driver/with-driver driver
(qp query rff context)))))) |
Middleware that resolves the Fields referenced by a query. | (ns metabase.query-processor.middleware.resolve-fields (:require [metabase.lib.metadata :as lib.metadata] [metabase.mbql.util :as mbql.u] [metabase.query-processor.error-type :as qp.error-type] [metabase.query-processor.store :as qp.store] [metabase.util :as u] [metabase.util.i18n :refer [tru]])) |
(defn- resolve-fields-with-ids!
[field-ids]
(qp.store/bulk-metadata :metadata/column field-ids)
(when-let [parent-ids (not-empty
(into []
(comp (map (fn [field-id]
(:parent-id (lib.metadata/field (qp.store/metadata-provider) field-id))))
(filter some?))
field-ids))]
(recur parent-ids))) | |
Resolve all field referenced in the | (defn resolve-fields
[query]
(let [ids (into (set (mbql.u/match (:query query) [:field (id :guard integer?) _] id))
(comp cat (keep :id))
(mbql.u/match (:query query) {:source-metadata source-metadata} source-metadata))]
(try
(u/prog1 query
(resolve-fields-with-ids! ids))
(catch Throwable e
(throw (ex-info (tru "Error resolving Fields in query: {0}" (ex-message e))
{:field-ids ids
:query query
:type qp.error-type/qp}
e)))))) |
Middleware that adds | (ns metabase.query-processor.middleware.resolve-joined-fields (:require [clojure.data :as data] [malli.core :as mc] [metabase.lib.metadata :as lib.metadata] [metabase.mbql.schema :as mbql.s] [metabase.mbql.util :as mbql.u] [metabase.query-processor.error-type :as qp.error-type] [metabase.query-processor.store :as qp.store] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log] [metabase.util.malli :as mu])) |
(def ^:private InnerQuery
[:and
:map
[:fn
{:error/message "Must have :source-table, :source-query, or :joins"}
(some-fn :source-table :source-query :joins)]
[:fn
{:error/message "Should not have :condition"}
(complement :condition)]]) | |
(mu/defn ^:private add-join-alias
[{:keys [table-id], field-id :id, :as field}
{:keys [joins source-query]} :- InnerQuery
[_ id-or-name opts :as clause] :- mbql.s/field:id]
(let [candidate-tables (filter (fn [join]
(when-let [source-table-id (mbql.u/join->source-table-id join)]
(= source-table-id table-id)))
joins)]
(case (count candidate-tables)
1
[:field
(if (string? id-or-name) field-id id-or-name)
(assoc opts :join-alias (-> candidate-tables first :alias))]
;; if there are no candidates, try looking for one in the source query if we have a source query. Otherwise we
;; can't do anything, so return field as-is
0
(if (empty? source-query)
clause
(recur field source-query clause))
;; if there are multiple candidates, try ignoring the implicit ones
;; presence of `:fk-field-id` indicates that the join was implicit, as the result of an `fk->` form
(let [explicit-joins (remove :fk-field-id joins)]
(if (= (count explicit-joins) 1)
(recur field {:joins explicit-joins} clause)
(let [{:keys [_id name]} (lib.metadata/table (qp.store/metadata-provider) table-id)]
(throw (ex-info (tru "Cannot resolve joined field due to ambiguous joins: table {0} (ID {1}) joined multiple times. You need to specify an explicit `:join-alias` in the field reference."
name field-id)
{:field field
:error qp.error-type/invalid-query
:joins joins
:candidates candidate-tables})))))))) | |
Get the ID of the 'primary' table towards which this query is pointing at: either the | (defn- primary-source-table-id
[{:keys [source-table source-query]}]
(or source-table
(when source-query
(recur source-query)))) |
Wrap Field clauses in a form that has | (mu/defn ^:private add-join-alias-to-fields-if-needed*
[{:keys [source-query joins], :as form} :- InnerQuery]
;; don't replace stuff in child `:join` or `:source-query` forms -- remove these from `form` when we call `replace`
(let [source-table (primary-source-table-id form)
form (mbql.u/replace (dissoc form :joins :source-query)
;; don't add `:join-alias` to anything that already has one
[:field _ (_ :guard :join-alias)]
&match
;; otherwise for any other `:field` whose table isn't the source Table, attempt to wrap it.
[:field
(field-id :guard (every-pred integer?
(fn [field-id]
(not= (:table-id (lib.metadata/field (qp.store/metadata-provider) field-id))
source-table))))
_]
(add-join-alias (lib.metadata/field (qp.store/metadata-provider) field-id) form &match))
;; add :joins and :source-query back which we removed above.
form (cond-> form
(seq joins) (assoc :joins joins)
source-query (assoc :source-query source-query))]
;; now deduplicate :fields clauses
(mbql.u/replace form
(m :guard (every-pred map? :fields))
(update m :fields distinct)))) |
(defn- add-join-alias-to-fields-if-needed
[form]
;; look for any form that has `:joins`, then wrap stuff as needed
(mbql.u/replace form
(m :guard (every-pred map? (mc/validator InnerQuery)))
(cond-> m
;; recursively wrap stuff in nested joins or source queries in the form
(:source-query m)
(update :source-query add-join-alias-to-fields-if-needed)
(seq (:joins m))
(update :joins (partial mapv add-join-alias-to-fields-if-needed))
;; now call `add-join-alias-to-fields-if-needed*` which actually does the wrapping.
true
add-join-alias-to-fields-if-needed*))) | |
Add | (defn resolve-joined-fields
[query]
(let [query' (add-join-alias-to-fields-if-needed query)]
(when-not (= query query')
(let [[before after] (data/diff query query')]
(log/tracef "Inferred :field :join-alias info: %s -> %s" (u/pprint-to-str 'yellow before) (u/pprint-to-str 'cyan after))))
query')) |
Middleware that fetches tables that will need to be joined, referred to by | (ns metabase.query-processor.middleware.resolve-joins
(:refer-clojure :exclude [alias])
(:require
[medley.core :as m]
[metabase.mbql.schema :as mbql.s]
[metabase.mbql.util :as mbql.u]
[metabase.query-processor.middleware.add-implicit-clauses
:as qp.add-implicit-clauses]
[metabase.query-processor.store :as qp.store]
[metabase.query-processor.util.add-alias-info :as add]
[metabase.util :as u]
[metabase.util.i18n :refer [tru]]
[metabase.util.malli :as mu])) |
Schema for a non-empty sequence of Joins. Unlike [[mbql.s/Joins]], this does not enforce the constraint that all join aliases be unique; that is handled by the [[metabase.query-processor.middleware.escape-join-aliases]] middleware. | (def ^:private Joins
[:sequential {:min 1} mbql.s/Join]) |
Schema for the parts of the query we're modifying. For use in the various intermediate transformations in the middleware. | (def ^:private UnresolvedMBQLQuery
[:map
[:joins [:sequential mbql.s/Join]]
[:fields {:optional true} mbql.s/Fields]]) |
Schema for the final results of this middleware. | (def ^:private ResolvedMBQLQuery
[:and
UnresolvedMBQLQuery
[:fn
{:error/message "Valid MBQL query where `:joins` `:fields` is sequence of Fields or removed"}
(fn [{:keys [joins]}]
(every?
(fn [{:keys [fields]}]
(or
(empty? fields)
(sequential? fields)))
joins))]]) |
+----------------------------------------------------------------------------------------------------------------+ | Resolving Tables & Fields / Saving in QP Store | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn ^:private resolve-fields! :- :nil [joins :- Joins] (qp.store/bulk-metadata :metadata/column (mbql.u/match joins [:field (id :guard integer?) _] id)) nil) | |
(mu/defn ^:private resolve-tables! :- :nil "Add Tables referenced by `:joins` to the Query Processor Store. This is only really needed for implicit joins, because their Table references are added after `resolve-source-tables` runs." [joins :- Joins] (qp.store/bulk-metadata :metadata/table (remove nil? (map :source-table joins))) nil) | |
+----------------------------------------------------------------------------------------------------------------+ | :Joins Transformations | +----------------------------------------------------------------------------------------------------------------+ | |
(def ^:private default-join-alias "__join") | |
(mu/defn ^:private merge-defaults :- mbql.s/Join
[join]
(merge {:alias default-join-alias, :strategy :left-join} join)) | |
(defn- source-metadata->fields [{:keys [alias], :as join} source-metadata]
(when-not (seq source-metadata)
(throw (ex-info (tru "Cannot use :fields :all in join against source query unless it has :source-metadata.")
{:join join})))
(let [duplicate-ids (into #{}
(keep (fn [[item freq]]
(when (> freq 1)
item)))
(frequencies (map :id source-metadata)))]
(for [{field-name :name, base-type :base_type, field-id :id} source-metadata]
(if (and field-id (not (contains? duplicate-ids field-id)))
;; field-id is a unique reference, use it
[:field field-id {:join-alias alias}]
[:field field-name {:base-type base-type, :join-alias alias}])))) | |
(mu/defn ^:private handle-all-fields :- mbql.s/Join
"Replace `:fields :all` in a join with an appropriate list of Fields."
[{:keys [source-table source-query alias fields source-metadata], :as join} :- mbql.s/Join]
(merge
join
(when (= fields :all)
{:fields (if source-query
(source-metadata->fields join source-metadata)
(for [[_ id-or-name opts] (qp.add-implicit-clauses/sorted-implicit-fields-for-table source-table)]
[:field id-or-name (assoc opts :join-alias alias)]))}))) | |
(mu/defn ^:private resolve-references :- Joins
[joins :- Joins]
(resolve-tables! joins)
(u/prog1 (into []
(comp (map merge-defaults)
(map handle-all-fields))
joins)
(resolve-fields! <>))) | |
(declare resolve-joins-in-mbql-query-all-levels) | |
(mu/defn ^:private resolve-join-source-queries :- Joins
[joins :- Joins]
(for [{:keys [source-query], :as join} joins]
(cond-> join
source-query resolve-joins-in-mbql-query-all-levels))) | |
+----------------------------------------------------------------------------------------------------------------+ | MBQL-Query Transformations | +----------------------------------------------------------------------------------------------------------------+ | |
Return a flattened list of all | (defn- joins->fields
[joins]
(into []
(comp (map :fields)
(filter sequential?)
cat)
joins)) |
Should we append the | (defn- should-add-join-fields?
[{breakouts :breakout, aggregations :aggregation}]
(every? empty? [aggregations breakouts])) |
(defn- append-join-fields [fields join-fields]
(into []
(comp cat
(m/distinct-by (fn [clause]
(-> clause
;; remove namespaced options and other things that are definitely irrelevant
add/normalize-clause
;; we shouldn't consider different type info to mean two Fields are different even if
;; everything else is the same. So give everything `:base-type` of `:type/*` (it will
;; complain if we remove `:base-type` entirely from fields with a string name)
(mbql.u/update-field-options (fn [opts]
(-> opts
(assoc :base-type :type/*)
(dissoc :effective-type))))))))
[fields join-fields])) | |
Add the fields from join | (defn append-join-fields-to-fields
[inner-query join-fields]
(cond-> inner-query
(seq join-fields) (update :fields append-join-fields join-fields))) |
(mu/defn ^:private merge-joins-fields :- UnresolvedMBQLQuery
"Append the `:fields` from `:joins` into their parent level as appropriate so joined columns appear in the final
query results, and remove the `:fields` entry for all joins.
If the parent-level query has breakouts and/or aggregations, this function won't append the joins fields to the
parent level, because we should only be returning the ones from the ags and breakouts in the final results."
[{:keys [joins], :as inner-query} :- UnresolvedMBQLQuery]
(let [join-fields (when (should-add-join-fields? inner-query)
(joins->fields joins))
;; remove remaining keyword `:fields` like `:none` from joins
inner-query (update inner-query :joins (fn [joins]
(mapv (fn [{:keys [fields], :as join}]
(cond-> join
(keyword? fields) (dissoc :fields)))
joins)))]
(append-join-fields-to-fields inner-query join-fields))) | |
(mu/defn ^:private resolve-joins-in-mbql-query :- ResolvedMBQLQuery
[query :- mbql.s/MBQLQuery]
(-> query
(update :joins (comp resolve-join-source-queries resolve-references))
merge-joins-fields)) | |
+----------------------------------------------------------------------------------------------------------------+ | Middleware & Boring Recursive Application Stuff | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- resolve-joins-in-mbql-query-all-levels
[{:keys [joins source-query], :as query}]
(cond-> query
(seq joins) resolve-joins-in-mbql-query
source-query (update :source-query resolve-joins-in-mbql-query-all-levels))) | |
Add any Tables and Fields referenced by the | (defn resolve-joins
[{inner-query :query, :as outer-query}]
(cond-> outer-query
inner-query (update :query resolve-joins-in-mbql-query-all-levels))) |
(ns metabase.query-processor.middleware.resolve-referenced
(:require
[metabase.lib.metadata.protocols :as lib.metadata.protocols]
[metabase.lib.schema.common :as lib.schema.common]
[metabase.lib.schema.id :as lib.schema.id]
[metabase.query-processor.middleware.fetch-source-query
:as fetch-source-query]
[metabase.query-processor.middleware.resolve-fields
:as qp.resolve-fields]
[metabase.query-processor.middleware.resolve-source-table
:as qp.resolve-source-table]
[metabase.query-processor.store :as qp.store]
[metabase.query-processor.util.tag-referenced-cards
:as qp.u.tag-referenced-cards]
[metabase.util.i18n :refer [tru]]
[metabase.util.malli :as mu]
[weavejester.dependency :as dep])
(:import
(clojure.lang ExceptionInfo))) | |
(defn- check-query-database-id=
[query database-id]
(when-not (= (:database query) database-id)
(throw (ex-info (tru "Referenced query is from a different database")
{:referenced-query query
:expected-database-id database-id})))) | |
(mu/defn ^:private resolve-referenced-card-resources* :- :map
[query]
(doseq [referenced-card (qp.u.tag-referenced-cards/tags-referenced-cards query)
:let [referenced-query (:dataset-query referenced-card)
resolved-query (fetch-source-query/resolve-card-id-source-tables* referenced-query)]]
(check-query-database-id= referenced-query (:database query))
(qp.resolve-source-table/resolve-source-tables resolved-query)
(qp.resolve-fields/resolve-fields resolved-query))
query) | |
(defn- card-subquery-graph
[graph card-id]
(let [card-query (:dataset-query (lib.metadata.protocols/card (qp.store/metadata-provider) card-id))]
(reduce
(fn [g sub-card-id]
(card-subquery-graph (dep/depend g card-id sub-card-id)
sub-card-id))
graph
(qp.u.tag-referenced-cards/query->tag-card-ids card-query)))) | |
(mu/defn ^:private circular-ref-error :- ::lib.schema.common/non-blank-string
[from-card :- ::lib.schema.id/card
to-card :- ::lib.schema.id/card]
(let [cards (into {}
(map (juxt :id :name))
(qp.store/bulk-metadata :metadata/card #{from-card to-card}))
from-name (get cards from-card)
to-name (get cards to-card)]
(str
(tru "This query has circular referencing sub-queries. ")
(tru "These questions seem to be part of the problem: \"{0}\" and \"{1}\"." from-name to-name)))) | |
(defn- check-for-circular-references
[query]
(try
;; `card-subquery-graph` will throw if there are circular references
(reduce card-subquery-graph (dep/graph) (qp.u.tag-referenced-cards/query->tag-card-ids query))
(catch ExceptionInfo e
(let [{:keys [reason node dependency]} (ex-data e)]
(if (= reason :weavejester.dependency/circular-dependency)
(throw (ex-info (circular-ref-error node dependency) {:original-exception e}))
(throw e)))))
query) | |
Resolves tables and fields referenced in card query template tags. | (defn resolve-referenced-card-resources [query] (-> query check-for-circular-references resolve-referenced-card-resources*)) |
Fetches Tables corresponding to any | (ns metabase.query-processor.middleware.resolve-source-table (:require [metabase.mbql.util :as mbql.u] [metabase.query-processor.store :as qp.store] [metabase.util.i18n :refer [tru]] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms])) |
Sanity check: Any non-positive-integer value of | (defn- check-all-source-table-ids-are-valid
[query]
(mbql.u/match-one query
(m :guard (every-pred map? :source-table #(string? (:source-table %))))
(throw
(ex-info
(tru "Invalid :source-table ''{0}'': should be resolved to a Table ID by now." (:source-table m))
{:form m})))) |
(mu/defn ^:private query->source-table-ids :- [:maybe [:set {:min 1} ms/PositiveInt]]
"Fetch a set of all `:source-table` IDs anywhere in `query`."
[query]
(some->
(mbql.u/match query
(m :guard (every-pred map? :source-table #(integer? (:source-table %))))
;; Recursively look in the rest of `m` for any other source tables
(cons
(:source-table m)
(filter some? (recur (dissoc m :source-table)))))
flatten
set)) | |
Middleware that will take any | (defn resolve-source-tables [query] (check-all-source-table-ids-are-valid query) (qp.store/bulk-metadata :metadata/table (query->source-table-ids query)) query) |
Middleware that stores metadata about results column types after running a query for a Card, and returns that metadata (which can be passed back to the backend when saving a Card) as well as a checksum in the API response. | (ns metabase.query-processor.middleware.results-metadata
(:require
[metabase.driver :as driver]
[metabase.lib.metadata :as lib.metadata]
[metabase.query-processor.reducible :as qp.reducible]
[metabase.query-processor.store :as qp.store]
[metabase.sync.analyze.query-results :as qr]
[metabase.util.i18n :refer [tru]]
[metabase.util.log :as log]
#_{:clj-kondo/ignore [:discouraged-namespace]}
[toucan2.core :as t2])) |
+----------------------------------------------------------------------------------------------------------------+ | Middleware | +----------------------------------------------------------------------------------------------------------------+ | |
TODO -
| (defn- record-metadata! [{{:keys [card-id]} :info, {:keys [source-card-id]} :query} metadata]
(try
;; At the very least we can skip the Extra DB call to update this Card's metadata results
;; if its DB doesn't support nested queries in the first place
(when (and metadata
driver/*driver*
(driver/database-supports? driver/*driver* :nested-queries (lib.metadata/database (qp.store/metadata-provider)))
card-id
(not source-card-id))
(t2/update! :model/Card card-id {:result_metadata metadata}))
;; if for some reason we weren't able to record results metadata for this query then just proceed as normal
;; rather than failing the entire query
(catch Throwable e
(log/error e (tru "Error recording results metadata for query"))))) |
Because insights are generated by reducing functions, they start working before the entire query metadata is in its
final form. Some columns come back without type information, and thus get an initial base type of This function merges inferred column base types added by | (defn- merge-final-column-metadata
[final-col-metadata insights-col-metadata]
;; the two metadatas will both be in order that matches the column order of the results
(mapv
(fn [{final-base-type :base_type, :as final-col} {our-base-type :base_type, :as insights-col}]
(merge
(select-keys final-col [:id :description :display_name :semantic_type :fk_target_field_id
:settings :field_ref :name :base_type :effective_type
:coercion_strategy :visibility_type])
insights-col
(when (= our-base-type :type/*)
{:base_type final-base-type})))
final-col-metadata
insights-col-metadata)) |
(defn- insights-xform [orig-metadata record! rf]
(qp.reducible/combine-additional-reducing-fns
rf
[(qr/insights-rf orig-metadata)]
(fn combine [result {:keys [metadata insights]}]
(let [metadata (merge-final-column-metadata (-> result :data :cols) metadata)]
(record! metadata)
(rf (cond-> result
(map? result)
(update :data
assoc
:results_metadata {:columns metadata}
:insights insights))))))) | |
Post-processing middleware that records metadata about the columns returned when running the query. | (defn record-and-return-metadata!
[{{:keys [skip-results-metadata?]} :middleware, :as query} rff]
(if skip-results-metadata?
rff
(let [record! (partial record-metadata! query)]
(fn record-and-return-metadata!-rff* [metadata]
(insights-xform metadata record! (rff metadata)))))) |
(ns metabase.query-processor.middleware.splice-params-in-response (:require [metabase.driver :as driver])) | |
(defn- splice-params-in-metadata [{{:keys [params]} :native_form, :as metadata}]
;; no need to i18n this since this message is something only developers who break the QP by changing middleware
;; order will see
(assert driver/*driver*
"Middleware order error: splice-params-in-response must run *after* driver is resolved.")
(if (empty? params)
metadata
(update metadata :native_form (partial driver/splice-parameters-into-native-query driver/*driver*)))) | |
Middleware that manipulates query response. Splice prepared statement (or equivalent) parameters directly into the
native query returned as part of successful query results. (This {:data {:native_form {:query "SELECT * FROM birds WHERE name = ?", :params ["Reggae"]}}} -> splice params in response -> {:data {:native_form {:query "SELECT * FROM birds WHERE name = 'Reggae'"}}} Note that this step happens after a query is executed; we do not want to execute the query with literals spliced in, so as to avoid SQL injection attacks. This feature is ultimately powered by the | (defn splice-params-in-response
[_query rff]
(fn splice-params-in-response-rff* [metadata]
(rff (splice-params-in-metadata metadata)))) |
The store middleware is responsible for initializing a fresh QP Store, which caches resolved objects for the duration
of a query execution. See | (ns metabase.query-processor.middleware.store (:require [metabase.query-processor.store :as qp.store])) |
Initialize the QP Store (resolved objects cache) for this query execution. | (defn initialize-store
[qp]
(fn [query rff context]
(assert (pos-int? (:database query))
"Query :database ID should have resolved by now by the metabase.query-processor.middleware.resolve-database-and-driver middleware")
(qp.store/with-metadata-provider (:database query)
(qp query rff context)))) |
(ns metabase.query-processor.middleware.upgrade-field-literals
(:require
[clojure.walk :as walk]
[medley.core :as m]
[metabase.mbql.util :as mbql.u]
[metabase.query-processor.middleware.resolve-fields
:as qp.resolve-fields]
[metabase.query-processor.store :as qp.store]
[metabase.util :as u]
[metabase.util.i18n :refer [trs]]
[metabase.util.log :as log])) | |
Log only one warning per QP run (regardless of message). | (defn- warn-once
[message]
;; Make sure QP store is available since we use caching below (it may not be in some unit tests)
(when (qp.store/initialized?)
;; by caching the block below, the warning will only get trigger a maximum of one time per query run. We don't need
;; to blow up the logs with a million warnings.
(qp.store/cached ::bad-clause-warning
(log/warn (u/colorize :red message))))) |
Check if the field-id and the (possibly missing) join-alias of | (defn- unique-reference?
[field-clause columns]
(let [[_ field-id {:keys [join-alias]}] field-clause
matches-by-id (filter #(= (:id %) field-id) columns)]
(or (nil? (next matches-by-id))
(->> matches-by-id (filter #(= (get-in % [:field-ref 2 :join-alias]) join-alias)) count (= 1))))) |
(defn- fix-clause [{:keys [source-aliases field-name->field]} [_ field-name options :as field-clause]]
;; attempt to find a corresponding Field ref from the source metadata.
(let [field-ref (:field_ref (get field-name->field field-name))
;; the map contains duplicate columns to support lowercase lookup
columns (set (vals field-name->field))]
(cond
field-ref
(mbql.u/match-one field-ref
;; If the matching Field ref is an integer `:field` clause then replace it with the corrected clause.
[:field (id :guard integer?) new-options]
(let [new-clause [:field id (merge new-options (dissoc options :base-type))]]
(if (unique-reference? new-clause columns)
new-clause
(u/prog1 field-clause
(warn-once
(format "Warning: upgrading field literal %s would result in an ambiguous reference. Not upgrading."
(pr-str field-clause))))))
;; Otherwise the Field clause in the source query uses a string Field name as well, but that name differs from
;; the one in `source-aliases`. Will this work? Not sure whether or not we need to log something about this.
[:field (field-name :guard string?) new-options]
(u/prog1 [:field field-name (merge new-options (dissoc options :base-type))]
(warn-once
(trs "Warning: clause {0} does not match a column in the source query. Attempting to correct this to {1}"
(pr-str field-clause)
(pr-str <>)))))
;; If the field name exists in the ACTUAL names returned by the source query then we're g2g and don't need to
;; complain about anything.
(contains? source-aliases field-name)
field-clause
;; no matching Field ref means there's no column with this name in the source query. The query may not work, so
;; log a warning about it. This query is probably not going to work so we should let everyone know why.
:else
(do
(warn-once
(trs "Warning: clause {0} refers to a Field that may not be present in the source query. Query may not work as expected. Found: {1}"
(pr-str field-clause) (pr-str (or (not-empty source-aliases)
(set (keys field-name->field))))))
field-clause)))) | |
(defn- upgrade-field-literals-one-level [{:keys [source-metadata], :as inner-query}]
(let [source-aliases (into #{} (keep :source_alias) source-metadata)
field-name->field (merge (m/index-by :name source-metadata)
(m/index-by (comp u/lower-case-en :name) source-metadata))]
(mbql.u/replace inner-query
;; don't upgrade anything inside `source-query` or `source-metadata`.
(_ :guard (constantly (some (set &parents) [:source-query :source-metadata])))
&match
;; look for `field` clauses that use a string name that doesn't appear in `source-aliases` (the ACTUAL names that
;; are returned by the source query)
[:field (field-name :guard (every-pred string? (complement source-aliases))) options]
(or (fix-clause {:inner-query inner-query, :source-aliases source-aliases, :field-name->field field-name->field}
&match)
&match)))) | |
Look for usage of | (defn upgrade-field-literals
[query]
(-> (walk/postwalk
(fn [form]
;; find maps that have `source-query` and `source-metadata`, but whose source query is an MBQL source query
;; rather than an native one
(if (and (map? form)
(:source-query form)
(seq (:source-metadata form))
;; we probably shouldn't upgrade things at all if we have a source MBQL query whose source is a native
;; query at ANY level, since `[:field <name>]` might mean `source.<name>` or it might mean
;; `some_join.<name>`. But we'll probably break more things than we fix if turn off this middleware in
;; that case. See #19757 for more info
(not (get-in form [:source-query :native])))
(upgrade-field-literals-one-level form)
form))
(qp.resolve-fields/resolve-fields query))
qp.resolve-fields/resolve-fields)) |
Middleware for checking that a normalized query is valid. | (ns metabase.query-processor.middleware.validate (:require [metabase.mbql.schema :as mbql.s])) |
Middleware that validates a query immediately after normalization. | (defn validate-query [query] (mbql.s/validate-query query) query) |
(ns metabase.query-processor.middleware.validate-temporal-bucketing (:require [clojure.set :as set] [metabase.lib.metadata :as lib.metadata] [metabase.mbql.util :as mbql.u] [metabase.query-processor.error-type :as qp.error-type] [metabase.query-processor.store :as qp.store] [metabase.util.i18n :refer [tru]])) | |
(def ^:private valid-date-units
#{:default :day :day-of-week :day-of-month :day-of-year
:week :week-of-year :month :month-of-year :quarter :quarter-of-year :year}) | |
(def ^:private valid-time-units
#{:default :millisecond :second :minute :minute-of-hour :hour :hour-of-day}) | |
(def ^:private valid-datetime-units (set/union valid-date-units valid-time-units)) | |
TODO -- this should be changed to | (defmulti ^:private valid-units-for-base-type
{:arglists '([base-type])}
keyword) |
for stuff like UNIX timestamps -- skip validation for now. (UNIX timestamp should be bucketable with any unit
anyway). Once | (defmethod valid-units-for-base-type :type/* [_] valid-datetime-units) (defmethod valid-units-for-base-type :type/Date [_] valid-date-units) (defmethod valid-units-for-base-type :type/Time [_] valid-time-units) (defmethod valid-units-for-base-type :type/DateTime [_] valid-datetime-units) |
Make sure temporal bucketing of Fields (i.e., | (defn validate-temporal-bucketing
[query]
(doseq [[_ id-or-name {:keys [temporal-unit base-type]} :as clause] (mbql.u/match (:query query) [:field _ (_ :guard :temporal-unit)])]
(let [base-type (if (integer? id-or-name)
(:base-type (lib.metadata/field (qp.store/metadata-provider) id-or-name))
base-type)
valid-units (valid-units-for-base-type base-type)]
(when-not (valid-units temporal-unit)
(throw (ex-info (tru "Unsupported temporal bucketing: You can''t bucket a {0} Field by {1}."
base-type temporal-unit)
{:type qp.error-type/invalid-query
:field clause
:base-type base-type
:unit temporal-unit
:valid-units valid-units})))))
query) |
(ns metabase.query-processor.middleware.visualization-settings (:require [medley.core :as m] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.protocols :as lib.metadata.protocols] [metabase.public-settings :as public-settings] [metabase.query-processor.store :as qp.store] [metabase.shared.models.visualization-settings :as mb.viz])) | |
(defn- normalize-field-settings
[id settings]
(let [db-form {(mb.viz/norm->db-column-ref {::mb.viz/field-id id}) settings}
norm-form (mb.viz/db->norm-column-settings db-form)]
(get norm-form {::mb.viz/field-id id}))) | |
For each field, fetch its settings from the QP store, convert the settings into the normalized form for visualization settings, and then merge in the card-level column settings. | (defn- update-card-viz-settings
[column-viz-settings field-ids]
;; Retrieve field-level settings
(let [field-id->settings (reduce
(fn [m field-id]
(let [field-settings (:settings (lib.metadata/field (qp.store/metadata-provider) field-id))
norm-field-settings (normalize-field-settings field-id field-settings)]
(cond-> m
(seq norm-field-settings)
(assoc field-id norm-field-settings))))
{}
field-ids)
;; For each column viz setting, if there is a match on the field settings, merge it in,
;; with the column viz settings being the default in the event of conflicts.
merged-settings (reduce-kv
(fn [coll {field-id ::mb.viz/field-id :as k} column-viz-setting]
(assoc coll k (merge (get field-id->settings field-id {}) column-viz-setting)))
{}
column-viz-settings)
;; The field-ids that are in the merged settings
viz-field-ids (set (map ::mb.viz/field-id (keys merged-settings)))
;; Keep any field settings that aren't in the merged settings and have settings
distinct-field-settings (update-keys
(remove (comp viz-field-ids first) field-id->settings)
(fn [k] {::mb.viz/field-id k}))]
(merge merged-settings distinct-field-settings))) |
Pull viz settings from either the query map or the DB | (defn- viz-settings
[query]
(or (let [viz (-> query :viz-settings)]
(when (seq viz) viz))
(when-let [card-id (-> query :info :card-id)]
(mb.viz/db->norm (:visualization-settings (lib.metadata.protocols/card (qp.store/metadata-provider) card-id)))))) |
Middleware for fetching and processing a table's visualization settings so that they can be incorporated into an export. Card-level visualization settings are either fetched from the DB (for saved cards) or passed from the frontend in the API call (for unsaved cards). These are merged with the base viz settings for each field that are fetched from the QP store (and defined in the data model settings). For native queries, viz settings passed from the frontend are used, without modification. Processed viz settings are added to the metadata under the key :viz-settings. | (defn update-viz-settings
[{{:keys [process-viz-settings?]} :middleware, :as query} rff]
(if process-viz-settings?
(let [card-viz-settings (viz-settings query)
normalized-card-viz-settings (mb.viz/db->norm card-viz-settings)
column-viz-settings (::mb.viz/column-settings card-viz-settings)
fields (or (-> query :query :fields)
(-> query :query :source-query :fields))
field-ids (filter int? (map second fields))
updated-column-viz-settings (if (= (:type query) :query)
(update-card-viz-settings column-viz-settings field-ids)
column-viz-settings)
global-settings (m/map-vals mb.viz/db->norm-column-settings-entries
(public-settings/custom-formatting))
updated-card-viz-settings (-> normalized-card-viz-settings
(assoc ::mb.viz/column-settings updated-column-viz-settings)
(assoc ::mb.viz/global-column-settings global-settings))]
(fn update-viz-settings-rff* [metadata]
(rff (assoc metadata :viz-settings updated-card-viz-settings))))
rff)) |
Middleware that wraps value literals in | (ns metabase.query-processor.middleware.wrap-value-literals (:require [metabase.lib.metadata :as lib.metadata] [metabase.mbql.schema :as mbql.s] [metabase.mbql.util :as mbql.u] [metabase.query-processor.store :as qp.store] [metabase.query-processor.timezone :as qp.timezone] [metabase.types :as types] [metabase.util :as u] [metabase.util.date-2 :as u.date]) (:import (java.time LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime ZonedDateTime))) |
--------------------------------------------------- Type Info ---------------------------------------------------- | |
Get information about database, base, and semantic types for an object. This is passed to along to various
| (defmulti ^:private type-info
{:arglists '([field-clause])}
mbql.u/dispatch-by-clause-name-or-class) |
(defmethod type-info :default [_] nil) | |
(defmethod type-info :metadata/column
[field]
(let [field-info (-> (select-keys field [:base-type :effective-type :coercion-strategy :semantic-type :database-type :name])
(update-keys u/->snake_case_en))]
(merge
field-info
;; add in a default unit for this Field so we know to wrap datetime strings in `absolute-datetime` below based on
;; its presence. Its unit will get replaced by the`:temporal-unit` in `:field` options in the method below if
;; present
(when (types/temporal-field? field-info)
{:unit :default})))) | |
(defmethod type-info :field [[_ id-or-name opts]]
(merge
(when (integer? id-or-name)
(type-info (lib.metadata/field (qp.store/metadata-provider) id-or-name)))
(when (:temporal-unit opts)
{:unit (:temporal-unit opts)})
(when (:base-type opts)
{:base_type (:base-type opts)}))) | |
------------------------------------------------- add-type-info -------------------------------------------------- | |
Wraps value literals in TODO -- parsing the temporal string literals should be moved into | (defmulti ^:private add-type-info
{:arglists '([x info & {:keys [parse-datetime-strings?]}])}
(fn [x & _] (class x))) |
(defmethod add-type-info nil [_ info & _] [:value nil info]) | |
(defmethod add-type-info Object [this info & _] [:value this info]) | |
(defmethod add-type-info LocalDate [this info & _] [:absolute-datetime this (get info :unit :default)]) | |
(defmethod add-type-info LocalDateTime [this info & _] [:absolute-datetime this (get info :unit :default)]) | |
(defmethod add-type-info LocalTime [this info & _] [:time this (get info :unit :default)]) | |
(defmethod add-type-info OffsetDateTime [this info & _] [:absolute-datetime this (get info :unit :default)]) | |
(defmethod add-type-info OffsetTime [this info & _] [:time this (get info :unit :default)]) | |
(defmethod add-type-info ZonedDateTime [this info & _] [:absolute-datetime this (get info :unit :default)]) | |
(defmethod add-type-info String
[this {:keys [unit], :as info} & {:keys [parse-datetime-strings?]
:or {parse-datetime-strings? true}}]
(if-let [temporal-value (when (and unit
parse-datetime-strings?
(string? this))
;; TIMEZONE FIXME - I think this should actually use
;; (qp.timezone/report-timezone-id-if-supported) instead ?
(u.date/parse this (qp.timezone/results-timezone-id)))]
(if (some #(instance? % temporal-value) [LocalTime OffsetTime])
[:time temporal-value unit]
[:absolute-datetime temporal-value unit])
[:value this info])) | |
-------------------------------------------- wrap-literals-in-clause --------------------------------------------- | |
(def ^:private raw-value? (complement mbql.u/mbql-clause?)) | |
Given a normalized mbql query (important to desugar forms like eg: [:not [:contains [:field 13 {:base_type :type/Text}] "foo"]] -> [:not [:contains [:field 13 {:base_type :type/Text}] [:value "foo" {:base_type :type/Text, :semantic_type nil, :database_type "VARCHAR", :name "description"}]]] | (defn wrap-value-literals-in-mbql
[mbql]
(mbql.u/replace mbql
[(clause :guard #{:= :!= :< :> :<= :>=}) field (x :guard raw-value?)]
[clause field (add-type-info x (type-info field))]
[:datetime-diff (x :guard string?) (y :guard string?) unit]
[:datetime-diff (add-type-info (u.date/parse x) nil) (add-type-info (u.date/parse y) nil) unit]
[(clause :guard #{:datetime-add :datetime-subtract :convert-timezone :temporal-extract}) (field :guard string?) & args]
(into [clause (add-type-info (u.date/parse field) nil)] args)
[:between field (min-val :guard raw-value?) (max-val :guard raw-value?)]
[:between
field
(add-type-info min-val (type-info field))
(add-type-info max-val (type-info field))]
[(clause :guard #{:starts-with :ends-with :contains}) field (s :guard string?) & more]
(let [s (add-type-info s (type-info field), :parse-datetime-strings? false)]
(into [clause field s] more)))) |
Extract value literal from | (defn unwrap-value-literal
[maybe-value-form]
(mbql.u/match-one maybe-value-form
[:value x & _] x
_ &match)) |
(defn ^:private wrap-value-literals-in-mbql-query
[{:keys [source-query], :as inner-query} options]
(let [inner-query (cond-> inner-query
source-query (update :source-query wrap-value-literals-in-mbql-query options))]
(wrap-value-literals-in-mbql inner-query))) | |
Middleware that wraps ran value literals in | (defn wrap-value-literals
[{query-type :type, :as query}]
(if-not (= query-type :query)
query
(mbql.s/validate-query
(update query :query wrap-value-literals-in-mbql-query nil)))) |
Pivot table actions for the query processor | (ns metabase.query-processor.pivot
(:require
[clojure.core.async :as a]
[metabase.lib.core :as lib]
[metabase.lib.equality :as lib.equality]
[metabase.lib.metadata.jvm :as lib.metadata.jvm]
[metabase.lib.schema.id :as lib.schema.id]
[metabase.mbql.normalize :as mbql.normalize]
[metabase.query-processor :as qp]
[metabase.query-processor.context :as qp.context]
[metabase.query-processor.context.default :as context.default]
[metabase.query-processor.error-type :as qp.error-type]
[metabase.query-processor.middleware.permissions :as qp.perms]
[metabase.query-processor.middleware.resolve-database-and-driver
:as qp.resolve-database-and-driver]
[metabase.query-processor.reducible :as qp.reducible]
[metabase.query-processor.store :as qp.store]
[metabase.util :as u]
[metabase.util.i18n :refer [trs tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu])) |
(set! *warn-on-reflection* true) | |
Generate a powerset while maintaining the original ordering as much as possible | (defn powerset
[xs]
(for [combo (reverse (range (int (Math/pow 2 (count xs)))))]
(for [item (range 0 (count xs))
:when (not (zero? (bit-and (bit-shift-left 1 item) combo)))]
(nth xs item)))) |
Come up with a display name given a combination of breakout This is basically a bitmask of which breakout indices we're excluding, but reversed. Why? This is how Postgres and other DBs determine group numbers. This implements basically what PostgreSQL does for grouping -- look at the original set of groups - if that column is part of this group, then set the appropriate bit (entry 1 sets bit 1, etc) (group-bitmask 3 [1]) ; -> [_ 1 _] -> 101 -> 101 -> 5 (group-bitmask 3 [1 2]) ; -> [_ 1 2] -> 100 -> 011 -> 1 | (defn- group-bitmask [num-breakouts indices] (transduce (map (partial bit-shift-left 1)) (completing bit-xor) (int (dec (Math/pow 2 num-breakouts))) indices)) |
Return a sequence of all breakout combinations (by index) we should generate queries for. (breakout-combinations 3 [1 2] nil) ;; -> [[0 1 2] [] [1 2] [2] [1]] | (defn- breakout-combinations
[num-breakouts pivot-rows pivot-cols]
;; validate pivot-rows/pivot-cols
(doseq [[k pivots] {:pivot-rows pivot-rows, :pivot-cols pivot-cols}
i pivots]
(when (>= i num-breakouts)
(throw (ex-info (tru "Invalid {0}: specified breakout at index {1}, but we only have {2} breakouts"
(name k) i num-breakouts)
{:type qp.error-type/invalid-query
:num-breakouts num-breakouts
:pivot-rows pivot-rows
:pivot-cols pivot-cols}))))
(sort-by
(partial group-bitmask num-breakouts)
(distinct
(map
vec
;; this can happen for the public/embed endpoints, where we aren't given a pivot-rows / pivot-cols parameter, so
;; we'll just generate everything
(if (empty? (concat pivot-rows pivot-cols))
(powerset (range 0 num-breakouts))
(concat
;; e.g. given num-breakouts = 4; pivot-rows = [0 1 2]; pivot-cols = [3]
;; primary data: return all breakouts
;; => [0 1 2 3] => 0000 => Group #15
[(range num-breakouts)]
;; subtotal rows
;; _.range(1, pivotRows.length).map(i => [...pivotRow.slice(0, i), ...pivotCols])
;; => [0 _ _ 3] [0 1 _ 3] => 0110 0100 => Group #6, #4
(for [i (range 1 (count pivot-rows))]
(concat (take i pivot-rows) pivot-cols))
;; “row totals” on the right
;; pivotRows
;; => [0 1 2 _] => 1000 => Group #8
[pivot-rows]
;; subtotal rows within “row totals”
;; _.range(1, pivotRows.length).map(i => pivotRow.slice(0, i))
;; => [0 _ _ _] [0 1 _ _] => 1110 1100 => Group #14, #12
(for [i (range 1 (count pivot-rows))]
(take i pivot-rows))
;; “grand totals” row
;; pivotCols
;; => [_ _ _ 3] => 0111 => Group #7
[pivot-cols]
;; bottom right corner [_ _ _ _] => 1111 => Group #15
[[]])))))) |
Add the grouping field and expression to the query | (defn- add-grouping-field
[query breakout bitmask]
(as-> query query
;;TODO: replace this value with a bitmask or something to indicate the source better
(update-in query [:query :expressions] assoc :pivot-grouping [:abs bitmask])
;; in PostgreSQL and most other databases, all the expressions must be present in the breakouts. Add a pivot
;; grouping expression ref to the breakouts
(assoc-in query [:query :breakout] (concat breakout [[:expression "pivot-grouping"]]))
(do
(log/tracef "Added pivot-grouping expression to query\n%s" (u/pprint-to-str 'yellow query))
query))) |
Only keep existing aggregations in | (defn- remove-non-aggregation-order-bys
[outer-query]
(update
outer-query
:query
(fn [query]
(if-let [new-order-by (not-empty (filterv (comp #(= :aggregation %) first second) (:order-by query)))]
(assoc query :order-by new-order-by)
(dissoc query :order-by))))) |
Generate the additional queries to perform a generic pivot table | (defn- generate-queries
[{{all-breakouts :breakout} :query, :keys [query], :as outer-query}
{:keys [pivot-rows pivot-cols], :as _pivot-options}]
(try
(for [breakout-indices (u/prog1 (breakout-combinations (count all-breakouts) pivot-rows pivot-cols)
(log/tracef "Using breakout combinations: %s" (pr-str <>)))
:let [group-bitmask (group-bitmask (count all-breakouts) breakout-indices)
new-breakouts (for [i breakout-indices]
(nth all-breakouts i))]]
(-> outer-query
remove-non-aggregation-order-bys
(add-grouping-field new-breakouts group-bitmask)))
(catch Throwable e
(throw (ex-info (tru "Error generating pivot queries")
{:type qp.error-type/qp, :query query}
e))))) |
Reduce the results of a single | (defn- process-query-append-results
[query rf init info context]
(if (a/poll! (qp.context/canceled-chan context))
(ensure-reduced init)
(let [rff (fn [_]
(fn
([] init)
([acc] acc)
([acc row] (rf acc ((:row-mapping-fn context) row context)))))
context {:canceled-chan (qp.context/canceled-chan context)}]
(try
(if info
(qp/process-userland-query-sync (assoc query :info info) rff context)
(qp/process-query-sync (dissoc query :info) rff context))
(catch Throwable e
(log/error e (trs "Error processing additional pivot table query"))
(throw e)))))) |
Reduce the results of a sequence of | (defn- process-queries-append-results
[init queries rf info context]
(reduce
(fn [acc query]
(process-query-append-results query rf acc info (assoc context
:pivot-column-mapping ((:column-mapping-fn context) query))))
init
queries)) |
Update Query Processor | (defn- append-queries-rff-and-context
[info rff context more-queries]
(let [vrf (volatile! nil)]
{:rff (fn [metadata]
(u/prog1 (rff metadata)
;; this captures the reducing function before composed with limit and other middleware
(vreset! vrf <>)))
:context (cond-> context
(seq more-queries)
(-> (update :executef
(fn [orig]
;; execute holds open a connection from [[execute-reducible-query]] so we need to manage
;; connections in the reducing part reducef. The default runf is what orchestrates this
;; together and we just pass the original executef to the reducing part so we can control
;; our multiple connections.
(fn multiple-executef [driver query _context respond]
(respond [orig driver] query))))
(assoc :reducef
;; signature usually has metadata in place of driver but we are hijacking
(fn multiple-reducing [rff context [orig-executef driver] query]
(let [respond (fn [metadata reducible-rows]
(let [rf (rff metadata)]
(assert (fn? rf))
(try
(transduce identity (completing rf) reducible-rows)
(catch Throwable e
(qp.context/raisef (ex-info (tru "Error reducing result rows")
{:type qp.error-type/qp}
e)
context)))))
acc (-> (orig-executef driver query context respond)
(process-queries-append-results
more-queries @vrf info context))]
;; completion arity can't be threaded because the value is derefed too early
(qp.context/reducedf (@vrf acc) context))))))})) |
Allows the query processor to handle multiple queries, stitched together to appear as one | (defn- process-multiple-queries
[[first-query & more-queries] info rff context]
(let [{:keys [rff context]} (append-queries-rff-and-context info rff context more-queries)]
(if info
(qp/process-query-and-save-with-max-results-constraints! first-query info rff context)
(qp/process-query (dissoc first-query :info) rff context)))) |
(mu/defn ^:private pivot-options :- [:map
[:pivot-rows [:maybe [:sequential [:int {:min 0}]]]]
[:pivot-cols [:maybe [:sequential [:int {:min 0}]]]]]
"Given a pivot table query and a card ID, looks at the `pivot_table.column_split` key in the card's visualization
settings and generates pivot-rows and pivot-cols to use for generating subqueries."
[query :- [:map
[:database ::lib.schema.id/database]]
viz-settings :- [:maybe :map]]
(let [column-split (:pivot_table.column_split viz-settings)
column-split-rows (seq (:rows column-split))
column-split-columns (seq (:columns column-split))
index-in-breakouts (when (or column-split-rows
column-split-columns)
(let [metadata-provider (or (:lib/metadata query)
(lib.metadata.jvm/application-database-metadata-provider (:database query)))
mlv2-query (lib/query metadata-provider query)
breakouts (into []
(map-indexed (fn [i col]
(assoc col ::i i)))
(lib/breakouts-metadata mlv2-query))]
(fn [legacy-ref]
(try
(::i (lib.equality/find-column-for-legacy-ref
mlv2-query
-1
legacy-ref
breakouts))
(catch Throwable e
(log/errorf e "Error finding matching column for ref %s" (pr-str legacy-ref))
nil)))))
pivot-rows (when column-split-rows
(into [] (keep index-in-breakouts) column-split-rows))
pivot-cols (when column-split-columns
(into [] (keep index-in-breakouts) column-split-columns))]
{:pivot-rows pivot-rows
:pivot-cols pivot-cols})) | |
Run the pivot query. Unlike many query execution functions, this takes You are expected to wrap this call in [[metabase.query-processor.streaming/streaming-response]] yourself. | (defn run-pivot-query
([query]
(run-pivot-query query nil))
([query info]
(run-pivot-query query info nil))
([query info context]
(run-pivot-query query info nil context))
([query info rff context]
(binding [qp.perms/*card-id* (get info :card-id)]
(qp.store/with-metadata-provider (qp.resolve-database-and-driver/resolve-database-id query)
(let [context (merge (context.default/default-context) context)
rff (or rff qp.reducible/default-rff)
query (mbql.normalize/normalize query)
pivot-options (or
(not-empty (select-keys query [:pivot-rows :pivot-cols]))
(pivot-options query (get info :visualization-settings)))
main-breakout (:breakout (:query query))
col-determination-query (add-grouping-field query main-breakout 0)
all-expected-cols (qp/query->expected-cols col-determination-query)
all-queries (generate-queries query pivot-options)]
(process-multiple-queries
all-queries
info
rff
(assoc context
;; this function needs to be executed at the start of every new query to
;; determine the mapping for maintaining query shape
:column-mapping-fn (fn [query]
(let [query-cols (map-indexed vector (qp/query->expected-cols query))]
(map (fn [item]
(some #(when (= (:name item) (:name (second %)))
(first %)) query-cols))
all-expected-cols)))
;; this function needs to be called for each row so that it can actually
;; shape the row according to the `:column-mapping-fn` above
:row-mapping-fn (fn [row context]
;; the first query doesn't need any special mapping, it already has all the columns
(if-let [col-mapping (:pivot-column-mapping context)]
(map (fn [mapping]
(when mapping
(nth row mapping)))
col-mapping)
row))))))))) |
(ns metabase.query-processor.reducible (:require [clojure.core.async :as a] [metabase.async.util :as async.u] [metabase.query-processor.context :as qp.context] [metabase.query-processor.context.default :as context.default] [metabase.util :as u] [metabase.util.log :as log])) | |
(set! *warn-on-reflection* true) | |
Default function returning a reducing function. Results are returned in the 'standard' map format e.g. {:data {:cols [...], :rows [...]}, :row_count ...} | (defn default-rff
[metadata]
(let [row-count (volatile! 0)
rows (volatile! [])]
(fn default-rf
([]
{:data metadata})
([result]
{:pre [(map? (unreduced result))]}
;; if the result is a clojure.lang.Reduced, unwrap it so we always get back the standard-format map
(-> (unreduced result)
(assoc :row_count @row-count
:status :completed)
(assoc-in [:data :rows] @rows)))
([result row]
(vswap! row-count inc)
(vswap! rows conj row)
result)))) |
The initial value of | (defn identity-qp [query rff context] (qp.context/runf query rff context)) |
Combine a collection of QP middleware into a single QP function. The QP function, like the middleware, will have the signature: (qp query rff context) | (defn combine-middleware
([middleware]
(combine-middleware middleware identity-qp))
([middleware qp]
(reduce
(fn [qp middleware]
(when (var? middleware)
(assert (not (:private (meta middleware))) (format "%s is private" (pr-str middleware))))
(if (some? middleware)
(middleware qp)
qp))
qp
middleware))) |
Wire up the core.async channels in a QP
Why isn't this just done automatically when we create the context in [[context.default/default-context]]? The timeout could be subject to change so it makes sense to wait until we actually run the query to wire stuff up. Also, since we're doing (merge (context.default/default-context) context) all over the place, it probably reduces overhead a bit to not run around adding a bunch of timeouts to channels we don't end up using. | (defn- wire-up-context-channels!
[context]
(let [out-chan (qp.context/out-chan context)
canceled-chan (qp.context/canceled-chan context)
timeout (qp.context/timeout context)]
(a/go
(let [[val port] (a/alts! [out-chan (a/timeout timeout)] :priority true)]
(log/tracef "Port %s got %s"
(if (= port out-chan) "out-chan" (format "[timeout after %s]" (u/format-milliseconds timeout)))
val)
(cond
(not= port out-chan) (qp.context/timeoutf context)
(nil? val) (a/>!! canceled-chan ::cancel))
(log/tracef "Closing out-chan.")
(a/close! out-chan)
(a/close! canceled-chan)))
nil)) |
Whether to run the query on a separate thread. When running a query asynchronously (i.e., with [[async-qp]]), this is
normally | (def ^:dynamic *run-on-separate-thread?* true) |
Wrap a QP function (middleware or a composition of middleware created with [[combine-middleware]]) with the signature: (qp query rff context) And return a function with the signatures: (qp query) (qp query context) While you can use a 3-arg QP function directly, this makes the function more user-friendly by providing a base
| (defn async-qp
[qp]
(fn qp*
([query]
(qp* query nil))
([query context]
(qp* query nil context))
([query rff context]
{:pre [(map? query) ((some-fn nil? map?) context)]}
(let [context (doto (merge (context.default/default-context) context)
wire-up-context-channels!)
rff (or rff default-rff)
thunk (fn [] (try
(qp query rff context)
(catch Throwable e
(qp.context/raisef e context))))]
(log/tracef "Running on separate thread? %s" *run-on-separate-thread?*)
(if *run-on-separate-thread?*
(future (thunk))
(thunk))
(qp.context/out-chan context))))) |
(defn- wait-for-async-result [out-chan]
{:pre [(async.u/promise-chan? out-chan)]}
(let [result (a/<!! out-chan)]
(if (instance? Throwable result)
(throw result)
result))) | |
Wraps a QP function created by [[async-qp]] into one that synchronously waits for query results and rethrows any Exceptions thrown. Resulting QP has the signatures (qp query) (qp query context) (qp query rff context) | (defn sync-qp
[qp]
{:pre [(fn? qp)]}
(fn qp* [& args]
(binding [*run-on-separate-thread?* false]
(wait-for-async-result (apply qp args))))) |
------------------------------------------------- Other Util Fns ------------------------------------------------- | |
Utility function for generating reducible rows when implementing [[metabase.driver/execute-reducible-query]].
| (defn reducible-rows
[row-thunk canceled-chan]
(reify
clojure.lang.IReduceInit
(reduce [_ rf init]
(loop [acc init]
(cond
(reduced? acc)
@acc
(a/poll! canceled-chan)
acc
:else
(if-let [row (row-thunk)]
(recur (rf acc row))
(do
(log/trace "All rows consumed.")
acc))))))) |
Utility function for creating a reducing function that reduces results using (fn my-xform [rf] (combine-additional-reducing-fns rf [((take 100) conj)] (fn combine [result first-100-values] (rf (assoc result :first-100 first-100-values))))) This is useful for post-processing steps that need to reduce the result rows to provide some metadata that can be added to the final result. This is conceptually similar to a combination of [[redux.core/juxt]] and [[redux.core/post-complete]], with these differences:
| (defn combine-additional-reducing-fns
[primary-rf additional-rfs combine]
{:pre [(fn? primary-rf) (sequential? additional-rfs) (every? fn? additional-rfs) (fn? combine)]}
(let [additional-accs (volatile! (mapv (fn [rf] (rf))
additional-rfs))]
(fn combine-additional-reducing-fns-rf*
([] (primary-rf))
([acc]
(let [additional-results (map (fn [rf acc]
(rf (unreduced acc)))
additional-rfs
@additional-accs)]
(apply combine acc additional-results)))
([acc x]
(vswap! additional-accs (fn [accs]
(mapv (fn [rf acc]
(if (reduced? acc)
acc
(rf acc x)))
additional-rfs
accs)))
(primary-rf acc x))))) |
The Query Processor Store caches resolved Tables and Fields for the duration of a query execution. Certain middleware handles resolving things like the query's source Table and any Fields that are referenced in a query, and saves the referenced objects in the store; other middleware and driver-specific query processor implementations use functions in the store to fetch those objects as needed. For example, a driver might be converting a Field ID clause (e.g. (qp.store/field 10) ;; get Field 10 Of course, it would be entirely possible to call | (ns metabase.query-processor.store (:require [medley.core :as m] [metabase.lib.convert :as lib.convert] [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.jvm :as lib.metadata.jvm] [metabase.lib.metadata.protocols :as lib.metadata.protocols] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.id :as lib.schema.id] [metabase.query-processor.error-type :as qp.error-type] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms])) |
(set! *warn-on-reflection* true) | |
(def ^:private uninitialized-store
(reify
clojure.lang.IDeref
(deref [_this]
(throw (ex-info "Error: Query Processor store is not initialized. Initialize it with qp.store/with-metadata-provider"
{}))))) | |
Dynamic var used as the QP store for a given query execution. | (def ^:private ^:dynamic *store* uninitialized-store) |
This is only for tests! When enabled, [[with-metadata-provider]] can completely replace the current metadata provider (and cache) with a new one. This is reset to false after the QP store is replaced the first time. | (def ^:dynamic *TESTS-ONLY-allow-replacing-metadata-provider* false) |
Is the QP store currently initialized? TODO -- rename this to something like | (defn initialized? [] (not (identical? *store* uninitialized-store))) |
Store a miscellaneous value in a the cache. Persists for the life of this QP invocation, including for recursive calls. | (mu/defn store-miscellaneous-value! [ks v] (swap! *store* assoc-in ks v)) |
Fetch a miscellaneous value from the cache. Unlike other Store functions, does not throw if value is not found. | (mu/defn miscellaneous-value ([ks] (miscellaneous-value ks nil)) ([ks not-found] (get-in @*store* ks not-found))) |
Attempt to fetch a miscellaneous value from the cache using key sequence See also | (defn cached-fn
[ks thunk]
(let [cached-value (miscellaneous-value ks ::not-found)]
(if-not (= cached-value ::not-found)
cached-value
(let [v (thunk)]
(store-miscellaneous-value! ks v)
v)))) |
Cache the value of Note that each use of ;; cache lookups of Card.dataset_query (qp.store/cached card-id (t2/select-one-fn :dataset_query Card :id card-id)) | (defmacro cached
{:style/indent 1}
[k-or-ks & body]
;; for the unique key use a gensym prefixed by the namespace to make for easier store debugging if needed
(let [ks (into [(list 'quote (gensym (str (name (ns-name *ns*)) "/misc-cache-")))] (u/one-or-many k-or-ks))]
`(cached-fn ~ks (fn [] ~@body)))) |
(mu/defn metadata-provider :- lib.metadata/MetadataProvider
"Get the [[metabase.lib.metadata.protocols/MetadataProvider]] that should be used inside the QP. "
[]
(or (miscellaneous-value [::metadata-provider])
(throw (ex-info "QP Store Metadata Provider is not initialized yet; initialize it with `qp.store/with-metadata-provider`."
{})))) | |
(mu/defn ^:private ->metadata-provider :- lib.metadata/MetadataProvider
[database-id-or-metadata-provider :- [:or
::lib.schema.id/database
lib.metadata/MetadataProvider]]
(if (integer? database-id-or-metadata-provider)
(lib.metadata.jvm/application-database-metadata-provider database-id-or-metadata-provider)
database-id-or-metadata-provider)) | |
Impl for [[with-metadata-provider]]; if there's already a provider, just make sure we're not trying to change the Database. We don't need to replace it. | (mu/defn ^:private validate-existing-provider
[database-id-or-metadata-provider :- [:or
::lib.schema.id/database
lib.metadata/MetadataProvider]]
(let [old-provider (miscellaneous-value [::metadata-provider])]
(when-not (identical? old-provider database-id-or-metadata-provider)
(let [new-database-id (if (integer? database-id-or-metadata-provider)
database-id-or-metadata-provider
(throw (ex-info "Cannot replace MetadataProvider with another one after it has been bound"
{:old-provider old-provider, :new-provider database-id-or-metadata-provider})))
existing-database-id (u/the-id (lib.metadata/database old-provider))]
(when-not (= new-database-id existing-database-id)
(throw (ex-info (tru "Attempting to initialize metadata provider with new Database {0}. Queries can only reference one Database. Already referencing: {1}"
(pr-str new-database-id)
(pr-str existing-database-id))
{:existing-id existing-database-id
:new-id new-database-id
:type qp.error-type/invalid-query}))))))) |
Create a new metadata provider and save it. | (mu/defn ^:private set-metadata-provider!
[database-id-or-metadata-provider :- [:or
::lib.schema.id/database
lib.metadata/MetadataProvider]]
(let [new-provider (->metadata-provider database-id-or-metadata-provider)]
;; validate the new provider.
(try
(lib.metadata/database new-provider)
(catch Throwable e
(throw (ex-info (format "Invalid MetadataProvider, failed to return valid Database: %s" (ex-message e))
{:metadata-provider new-provider}
e))))
(store-miscellaneous-value! [::metadata-provider] new-provider))) |
Implementation for [[with-metadata-provider]]. | (defn do-with-metadata-provider
[database-id-or-metadata-provider thunk]
(cond
(or (not (initialized?))
*TESTS-ONLY-allow-replacing-metadata-provider*)
(binding [*store* (atom {})
*TESTS-ONLY-allow-replacing-metadata-provider* false]
(do-with-metadata-provider database-id-or-metadata-provider thunk))
;; existing provider
(miscellaneous-value [::metadata-provider])
(do
(validate-existing-provider database-id-or-metadata-provider)
(thunk))
:else
(do
(set-metadata-provider! database-id-or-metadata-provider)
(thunk)))) |
Execute If a MetadataProvider is already bound, this is a no-op. | (defmacro with-metadata-provider
{:style/indent [:defn]}
[database-id-or-metadata-provider & body]
`(do-with-metadata-provider ~database-id-or-metadata-provider (^:once fn* [] ~@body))) |
(defn- missing-bulk-metadata-error [metadata-type id]
(ex-info (tru "Failed to fetch {0} {1}" (pr-str metadata-type) (pr-str id))
{:status-code 400
:type qp.error-type/invalid-query
:metadata-provider (metadata-provider)
:metadata-type metadata-type
:id id})) | |
(mu/defn bulk-metadata :- [:maybe [:sequential [:map
[:lib/type :keyword]
[:id ::lib.schema.common/positive-int]]]]
"Fetch multiple objects in bulk. If our metadata provider is a bulk provider (e.g., the application database metadata
provider), does a single fetch with [[lib.metadata.protocols/bulk-metadata]] if not (i.e., if this is a mock
provider), fetches them with repeated calls to the appropriate single-object method,
e.g. [[lib.metadata.protocols/field]].
The order of the returned objects will match the order of `ids`, and the response is guaranteed to contain every
object referred to by `ids`. Throws an exception if any objects could not be fetched.
This can also be called for side-effects to warm the cache."
[metadata-type :- [:enum :metadata/card :metadata/column :metadata/metric :metadata/segment :metadata/table]
ids :- [:maybe
[:or
[:set ::lib.schema.common/positive-int]
[:sequential ::lib.schema.common/positive-int]]]]
(when-let [ids-set (not-empty (set ids))]
(let [provider (metadata-provider)
objects (vec (if (satisfies? lib.metadata.protocols/BulkMetadataProvider provider)
(filter some? (lib.metadata.protocols/bulk-metadata provider metadata-type ids-set))
(let [f (case metadata-type
:metadata/card lib.metadata.protocols/card
:metadata/column lib.metadata.protocols/field
:metadata/metric lib.metadata.protocols/metric
:metadata/segment lib.metadata.protocols/segment
:metadata/table lib.metadata.protocols/table)]
(for [id ids-set]
(f provider id)))))
id->object (m/index-by :id objects)]
(mapv (fn [id]
(or (get id->object id)
(throw (missing-bulk-metadata-error metadata-type id))))
ids)))) | |
DEPRECATED STUFF | |
(def ^:private ^{:deprecated "0.48.0"} LegacyDatabaseMetadata
[:map
[:id ::lib.schema.id/database]
[:engine :keyword]
[:name ms/NonBlankString]
[:details :map]
[:settings [:maybe :map]]]) | |
(def ^:private ^{:deprecated "0.48.0"} LegacyTableMetadata
[:map
[:schema [:maybe :string]]
[:name ms/NonBlankString]]) | |
(def ^:private ^{:deprecated "0.48.0"} LegacyFieldMetadata
[:map
[:name ms/NonBlankString]
[:table_id ::lib.schema.id/table]
[:display_name ms/NonBlankString]
[:description [:maybe :string]]
[:database_type ms/NonBlankString]
[:base_type ms/FieldType]
[:semantic_type [:maybe ms/FieldSemanticOrRelationType]]
[:fingerprint [:maybe :map]]
[:parent_id [:maybe ::lib.schema.id/field]]
[:nfc_path [:maybe [:sequential ms/NonBlankString]]]
;; there's a tension as we sometimes store fields from the db, and sometimes store computed fields. ideally we
;; would make everything just use base_type.
[:effective_type {:optional true} [:maybe ms/FieldType]]
[:coercion_strategy {:optional true} [:maybe ms/CoercionStrategy]]]) | |
For compatibility: convert MLv2-style metadata as returned by [[metabase.lib.metadata.protocols]]
or [[metabase.lib.metadata]] functions
(with Try to avoid using this, we would like to remove this in the near future. | (defn ->legacy-metadata
{:deprecated "0.48.0"}
[mlv2-metadata]
(let [model (case (:lib/type mlv2-metadata)
:metadata/database :model/Database
:metadata/table :model/Table
:metadata/column :model/Field)]
(-> mlv2-metadata
(dissoc :lib/type)
(update-keys u/->snake_case_en)
(vary-meta assoc :type model)
(m/update-existing :field_ref lib.convert/->legacy-MBQL)))) |
#_{:clj-kondo/ignore [:deprecated-var]}
(mu/defn database :- LegacyDatabaseMetadata
"Fetch the Database referenced by the current query from the QP Store. Throws an Exception if valid item is not
returned.
Deprecated in favor of [[metabase.lib.metadata/database]] + [[metadata-provider]]."
{:deprecated "0.48.0"}
[]
(->legacy-metadata (lib.metadata/database (metadata-provider)))) | |
#_{:clj-kondo/ignore [:deprecated-var]}
(mu/defn ^:deprecated table :- LegacyTableMetadata
"Fetch Table with `table-id` from the QP Store. Throws an Exception if valid item is not returned.
Deprecated in favor of [[metabase.lib.metadata/table]] + [[metadata-provider]]."
{:deprecated "0.48.0"}
[table-id :- ::lib.schema.id/table]
(-> (or (lib.metadata.protocols/table (metadata-provider) table-id)
(throw (ex-info (tru "Failed to fetch Table {0}: Table does not exist, or belongs to a different Database."
(pr-str table-id))
{:status-code 404
:type qp.error-type/invalid-query
:table-id table-id})))
->legacy-metadata)) | |
#_{:clj-kondo/ignore [:deprecated-var]}
(mu/defn ^:deprecated field :- LegacyFieldMetadata
"Fetch Field with `field-id` from the QP Store. Throws an Exception if valid item is not returned.
Deprecated in favor of [[metabase.lib.metadata/field]] + [[metadata-provider]]."
{:deprecated "0.48.0"}
[field-id :- ::lib.schema.id/field]
(-> (or (lib.metadata.protocols/field (metadata-provider) field-id)
(throw (ex-info (tru "Failed to fetch Field {0}: Field does not exist, or belongs to a different Database."
(pr-str field-id))
{:status-code 404
:type qp.error-type/invalid-query
:field-id field-id})))
->legacy-metadata)) | |
(ns metabase.query-processor.streaming (:require [clojure.core.async :as a] [metabase.async.streaming-response :as streaming-response] [metabase.mbql.util :as mbql.u] [metabase.query-processor.context :as qp.context] [metabase.query-processor.context.default :as context.default] [metabase.query-processor.streaming.csv :as qp.csv] [metabase.query-processor.streaming.interface :as qp.si] [metabase.query-processor.streaming.json :as qp.json] [metabase.query-processor.streaming.xlsx :as qp.xlsx] [metabase.shared.models.visualization-settings :as mb.viz] [metabase.util :as u]) (:import (clojure.core.async.impl.channels ManyToManyChannel) (java.io OutputStream) (metabase.async.streaming_response StreamingResponse))) | |
(set! *warn-on-reflection* true) | |
these are loaded for side-effects so their impls of | (comment qp.csv/keep-me
qp.json/keep-me
qp.xlsx/keep-me) |
Deduplicate column names that would otherwise conflict. TODO: This function includes logic that is normally is done by the annotate middleware, but hasn't been run yet at this point in the code. We should eventually refactor this (#17195) | (defn- deduplicate-col-names
[cols]
(map (fn [col unique-name]
(let [col-with-display-name (if (:display_name col)
col
(assoc col :display_name (:name col)))]
(assoc col-with-display-name :name unique-name)))
cols
(mbql.u/uniquify-names (map :name cols)))) |
Validate that all of the columns in | (defn- validate-table-columms
[table-columns cols]
(let [col-field-refs (set (remove nil? (map :field_ref cols)))
col-names (set (remove nil? (map :name cols)))]
(when (every? (fn [table-col] (or (col-field-refs (::mb.viz/table-column-field-ref table-col))
(col-names (::mb.viz/table-column-name table-col))))
table-columns)
table-columns))) |
For each entry in The resulting list of indices determines the order of column names and data in exports. | (defn- export-column-order
[cols table-columns]
(let [table-columns' (or (validate-table-columms table-columns cols)
;; If table-columns is not provided (e.g. for saved cards), we can construct a fake one
;; that retains the original column ordering in `cols`
(for [col cols]
(let [col-name (:name col)
id-or-name (or (:id col) col-name)
field-ref (:field_ref col)]
{::mb.viz/table-column-field-ref (or field-ref [:field id-or-name nil])
::mb.viz/table-column-enabled true
::mb.viz/table-column-name col-name})))
enabled-table-cols (filter ::mb.viz/table-column-enabled table-columns')
cols-vector (into [] cols)
;; cols-index is a map from keys representing fields to their indices into `cols`
cols-index (reduce-kv (fn [m i col]
;; Always add col-name as a key, so that native queries and remapped fields work correctly
(let [m' (assoc m (:name col) i)]
(if-let [field-ref (:field_ref col)]
;; Add a map key based on the column's field-ref, if available
(assoc m' field-ref i)
m')))
{}
cols-vector)]
(->> (map
(fn [{field-ref ::mb.viz/table-column-field-ref, col-name ::mb.viz/table-column-name}]
(let [index (or (get cols-index field-ref)
(get cols-index col-name))
col (get cols-vector index)
remapped-to-name (:remapped_to col)
remapped-from-name (:remapped_from col)]
(cond
remapped-to-name
(get cols-index remapped-to-name)
(not remapped-from-name)
index)))
enabled-table-cols)
(remove nil?)))) |
Dedups and orders | (defn order-cols
[cols viz-settings]
(let [deduped-cols (deduplicate-col-names cols)
output-order (export-column-order deduped-cols (::mb.viz/table-columns viz-settings))
ordered-cols (if output-order
(let [v (into [] deduped-cols)]
(for [i output-order] (v i)))
deduped-cols)]
[ordered-cols output-order])) |
(defn- streaming-rff [results-writer]
(fn [{:keys [cols viz-settings] :as initial-metadata}]
(let [[ordered-cols output-order] (order-cols cols viz-settings)
viz-settings' (assoc viz-settings :output-order output-order)
row-count (volatile! 0)]
(fn
([]
(qp.si/begin! results-writer
{:data (assoc initial-metadata :ordered-cols ordered-cols)}
viz-settings')
{:data initial-metadata})
([metadata]
(assoc metadata
:row_count @row-count
:status :completed))
([metadata row]
(qp.si/write-row! results-writer row (dec (vswap! row-count inc)) ordered-cols viz-settings')
metadata))))) | |
(defn- streaming-reducedf [results-writer ^OutputStream os]
(fn [final-metadata context]
(qp.si/finish! results-writer final-metadata)
(u/ignore-exceptions
(.flush os)
(.close os))
(qp.context/resultf final-metadata context))) | |
Context to pass to the QP to streaming results as (with-open [os ...] (let [{:keys [rff context]} (qp.streaming/streaming-context-and-rff :csv os canceled-chan)] (qp/process-query query rff context))) | (defn streaming-context-and-rff
([export-format os]
(let [results-writer (qp.si/streaming-results-writer export-format os)]
{:context (merge (context.default/default-context)
{:reducedf (streaming-reducedf results-writer os)})
:rff (streaming-rff results-writer)}))
([export-format os canceled-chan]
(assoc-in (streaming-context-and-rff export-format os) [:context :canceled-chan] canceled-chan))) |
(defn- await-async-result [out-chan canceled-chan]
;; if we get a cancel message, close `out-chan` so the query will be canceled
(a/go
(when (a/<! canceled-chan)
(a/close! out-chan)))
;; block until `out-chan` closes or gets a result
(a/<!! out-chan)) | |
Impl for | (defn streaming-response*
^StreamingResponse [export-format filename-prefix f]
(streaming-response/streaming-response (qp.si/stream-options export-format filename-prefix) [os canceled-chan]
(let [{:keys [rff context]} (streaming-context-and-rff export-format os canceled-chan)
result (try
(f {:rff rff, :context context})
(catch Throwable e
e))
result (if (instance? ManyToManyChannel result)
(await-async-result result canceled-chan)
result)]
(when (or (instance? Throwable result)
(= (:status result) :failed))
(streaming-response/write-error! os result))))) |
Return results of processing a query as a streaming response. This response implements the appropriate Ring/Compojure
protocols, so return or Typical example: (api/defendpoint-schema GET "/whatever" [] (qp.streaming/streaming-response [{:keys [rff context]} :json] (qp/process-query-and-save-with-max-results-constraints! (assoc query :async true) rff context))) Handles either async or sync QP results, but you should prefer returning sync results so we can handle query cancelations properly. | (defmacro streaming-response
{:style/indent 1}
[[map-binding export-format filename-prefix] & body]
`(streaming-response* ~export-format ~filename-prefix (bound-fn [~map-binding] ~@body))) |
Set of valid streaming response formats. Currently, | (defn export-formats [] (set (keys (methods qp.si/stream-options)))) |
Shared util fns for various export (download) streaming formats. | (ns metabase.query-processor.streaming.common (:require [clojure.string :as str] [java-time.api :as t] [medley.core :as m] [metabase.public-settings :as public-settings] [metabase.query-processor.store :as qp.store] [metabase.query-processor.timezone :as qp.timezone] [metabase.shared.models.visualization-settings :as mb.viz] [metabase.shared.util.currency :as currency] [metabase.util.date-2 :as u.date]) (:import (clojure.lang ISeq) (java.time LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime ZonedDateTime))) |
Set the time zone of a temporal value ;; if result timezone is | (defn in-result-time-zone [t] (u.date/with-time-zone-same-instant t (qp.store/cached ::results-timezone (t/zone-id (qp.timezone/results-timezone-id))))) |
Protocol for specifying how objects of various classes in QP result rows should be formatted in various download results formats (e.g. CSV, as opposed to the 'normal' API response format, which doesn't use this logic). | (defprotocol FormatValue
(format-value [this]
"Format this value in a QP result row appropriately for a results download, such as CSV.")) |
(extend-protocol FormatValue
nil
(format-value [_] nil)
Object
(format-value [this] this)
ISeq
(format-value [this]
(mapv format-value this))
LocalDate
(format-value [t]
(u.date/format t))
LocalDateTime
(format-value [t]
(if (= (t/local-time t) (t/local-time 0))
(format-value (t/local-date t))
(u.date/format t)))
LocalTime
(format-value [t]
(u.date/format t))
OffsetTime
(format-value [t]
(u.date/format (in-result-time-zone t)))
OffsetDateTime
(format-value [t]
(u.date/format (in-result-time-zone t)))
ZonedDateTime
(format-value [t]
(format-value (t/offset-date-time t)))) | |
Merge format settings defined in the localization preferences into the format settings for a single column. | (defn merge-global-settings
[format-settings global-settings-key]
(let [global-settings (get (public-settings/custom-formatting) global-settings-key)
normalized (mb.viz/db->norm-column-settings-entries global-settings)]
(merge normalized format-settings))) |
Given the format settings for a currency column, returns the symbol, code or name for the appropriate currency. | (defn currency-identifier
[format-settings]
(let [currency-code (::mb.viz/currency format-settings "USD")]
(condp = (::mb.viz/currency-style format-settings "symbol")
"symbol"
(if (currency/supports-symbol? currency-code)
(get-in currency/currency [(keyword currency-code) :symbol])
;; Fall back to using code if symbol isn't supported on the Metabase frontend
currency-code)
"code"
currency-code
"name"
(get-in currency/currency [(keyword currency-code) :name_plural])))) |
Generates the column titles that should be used in the export, taking into account viz settings. | (defn column-titles
[ordered-cols col-settings]
(for [col ordered-cols]
(let [id-or-name (or (and (:remapped_from col) (:fk_field_id col))
(:id col)
(:name col))
col-settings' (update-keys col-settings #(select-keys % [::mb.viz/field-id ::mb.viz/column-name]))
format-settings (or (get col-settings' {::mb.viz/field-id id-or-name})
(get col-settings' {::mb.viz/column-name id-or-name}))
is-currency? (or (isa? (:semantic_type col) :type/Currency)
(= (::mb.viz/number-style format-settings) "currency"))
merged-settings (if is-currency?
(merge-global-settings format-settings :type/Currency)
format-settings)
column-title (or (::mb.viz/column-title merged-settings)
(:display_name col)
(:name col))]
(if (and is-currency? (::mb.viz/currency-in-header merged-settings true))
(str column-title " (" (currency-identifier merged-settings) ")")
column-title)))) |
Update map keys to remove namespaces from keywords and convert from snake to kebab case. | (defn normalize-keys [m] (update-keys m (fn [k] (some-> k name (str/replace #"_" "-") keyword)))) |
The dispatch function logic for format format-timestring. Find the highest type of the object. | (def col-type (some-fn :semantic_type :effective_type :base_type)) |
Look up the global viz settings based on the type of the column. A multimethod is used because they match well against type hierarchies. | (defmulti global-type-settings (fn [col _viz-settings] (col-type col))) |
(defmethod global-type-settings :type/Temporal [_ {::mb.viz/keys [global-column-settings] :as _viz-settings}]
(:type/Temporal global-column-settings {})) | |
(defmethod global-type-settings :type/Date [_ {::mb.viz/keys [global-column-settings] :as _viz-settings}]
(merge
(:type/Temporal global-column-settings {})
{::mb.viz/time-enabled nil})) | |
(defmethod global-type-settings :type/Time [_ {::mb.viz/keys [global-column-settings] :as _viz-settings}]
(merge
(:type/Temporal global-column-settings {::mb.viz/time-style "h:mm A"})
{::mb.viz/date-style ""})) | |
(defmethod global-type-settings :type/DateTime [_ {::mb.viz/keys [global-column-settings] :as _viz-settings}]
(:type/Temporal global-column-settings {})) | |
(defmethod global-type-settings :type/Number [_ {::mb.viz/keys [global-column-settings] :as _viz-settings}]
(:type/Number global-column-settings {})) | |
(defmethod global-type-settings :type/Currency [_ {::mb.viz/keys [global-column-settings] :as _viz-settings}]
(merge
{::mb.viz/number-style "currency"}
(:type/Currency global-column-settings))) | |
(defmethod global-type-settings :default [_ _viz-settings]
{}) | |
Look up the setting defaults based on any information in the column-settings. This is the case when a column has no special type (e.g. a number) but the user has specified that the type is currency. We prefer the currency defaults to the number defaults. | (defn- column-setting-defaults
[global-column-settings column-settings]
(case (::mb.viz/number-style column-settings)
"currency" (:type/Currency global-column-settings)
{})) |
The ::mb.viz/global-column-settings comes from (public-settings/custom-formatting) and is provided by the query
processor in the | (defn- ensure-global-viz-settings
[{::mb.viz/keys [global-column-settings] :as viz-settings}]
(cond-> viz-settings
(nil? global-column-settings)
(assoc ::mb.viz/global-column-settings
(m/map-vals mb.viz/db->norm-column-settings-entries
(public-settings/custom-formatting))))) |
Get the unified viz settings for a column based on the column's metadata (if any) and user settings (⚙). | (defn viz-settings-for-col
[{column-name :name metadata-column-settings :settings :keys [field_ref] :as col} viz-settings]
(let [{::mb.viz/keys [global-column-settings] :as viz-settings} (ensure-global-viz-settings viz-settings)
[_ field-id-or-name] field_ref
all-cols-settings (-> viz-settings
::mb.viz/column-settings
;; update the keys so that they will have only the :field-id or :column-name
;; and not have any metadata. Since we don't know the metadata, we can never
;; match a key with metadata, even if we do have the correct name or id
(update-keys #(select-keys % [::mb.viz/field-id ::mb.viz/column-name])))
column-settings (or (all-cols-settings {::mb.viz/field-id field-id-or-name})
(all-cols-settings {::mb.viz/column-name (or field-id-or-name column-name)}))]
(merge
;; The default global settings based on the type of the column
(global-type-settings col viz-settings)
;; Generally, we want to look up the default global settings based on semantic or effective type. However, if
;; a user has specified other settings, we should look up the base type of those settings and combine them.
(column-setting-defaults global-column-settings column-settings)
;; User defined metadata -- Note that this transformation should probably go in
;; `metabase.query-processor.middleware.results-metadata/merge-final-column-metadata
;; to prevent repetition
(mb.viz/db->norm-column-settings-entries metadata-column-settings)
;; Column settings coming from the user settings in the ui
;; (E.g. Click the ⚙️on the column)
column-settings))) |
(ns metabase.query-processor.streaming.csv (:require [clojure.data.csv :as csv] [java-time.api :as t] [metabase.formatter :as formatter] [metabase.query-processor.streaming.common :as common] [metabase.query-processor.streaming.interface :as qp.si] [metabase.shared.models.visualization-settings :as mb.viz] [metabase.util.date-2 :as u.date]) (:import (java.io BufferedWriter OutputStream OutputStreamWriter) (java.nio.charset StandardCharsets))) | |
(set! *warn-on-reflection* true) | |
(defmethod qp.si/stream-options :csv
([_]
(qp.si/stream-options :csv "query_result"))
([_ filename-prefix]
{:content-type "text/csv"
:status 200
:headers {"Content-Disposition" (format "attachment; filename=\"%s_%s.csv\""
(or filename-prefix "query_result")
(u.date/format (t/zoned-date-time)))}
:write-keepalive-newlines? false})) | |
(defmethod qp.si/streaming-results-writer :csv
[_ ^OutputStream os]
(let [writer (BufferedWriter. (OutputStreamWriter. os StandardCharsets/UTF_8))
ordered-formatters (volatile! nil)]
(reify qp.si/StreamingResultsWriter
(begin! [_ {{:keys [ordered-cols results_timezone]} :data} viz-settings]
(let [col-names (common/column-titles ordered-cols (::mb.viz/column-settings viz-settings))]
(vreset! ordered-formatters (mapv (fn [col]
(formatter/create-formatter results_timezone col viz-settings))
ordered-cols))
(csv/write-csv writer [col-names])
(.flush writer)))
(write-row! [_ row _row-num _ {:keys [output-order]}]
(let [ordered-row (if output-order
(let [row-v (into [] row)]
(for [i output-order] (row-v i)))
row)]
(csv/write-csv writer [(map (fn [formatter r]
(formatter (common/format-value r)))
@ordered-formatters ordered-row)])
(.flush writer)))
(finish! [_ _]
;; TODO -- not sure we need to flush both
(.flush writer)
(.flush os)
(.close writer))))) | |
(ns metabase.query-processor.streaming.interface (:require [potemkin.types :as p.types])) | |
Options for the streaming response for this specific stream type. See | (defmulti stream-options
{:arglists '([export-format] [export-format filename-prefix])}
(fn ([export-format & _] (keyword export-format)))) |
Protocol for the methods needed to write streaming QP results. This protocol is a higher-level interface to intended to have multiple implementations. | (p.types/defprotocol+ StreamingResultsWriter
(begin! [this initial-metadata viz-settings]
"Write anything needed before writing the first row. `initial-metadata` is incomplete metadata provided before
rows begin reduction; some metadata such as insights won't be available until we finish.")
(write-row! [this row row-num col viz-settings]
"Write a row. `row` is a sequence of values in the row. `row-num` is the zero-indexed row number. `cols` is
an ordered list of columns in the export.")
(finish! [this final-metadata]
"Write anything needed after writing the last row. `final-metadata` is the final, complete metadata available
after reducing all rows. Very important: This method *must* `.close` the underlying OutputStream when it is
finshed.")) |
Given a | (defmulti streaming-results-writer
{:arglists '(^metabase.query_processor.streaming.interface.StreamingResultsWriter [export-format ^java.io.OutputStream os])}
(fn [export-format _os]
(keyword export-format))) |
Impls for JSON-based QP streaming response types. | (ns metabase.query-processor.streaming.json (:require [cheshire.core :as json] [java-time.api :as t] [metabase.formatter :as formatter] [metabase.query-processor.streaming.common :as common] [metabase.query-processor.streaming.interface :as qp.si] [metabase.shared.models.visualization-settings :as mb.viz] [metabase.util.date-2 :as u.date]) (:import (java.io BufferedWriter OutputStream OutputStreamWriter) (java.nio.charset StandardCharsets))) |
(set! *warn-on-reflection* true) | |
(defmethod qp.si/stream-options :json
([_]
(qp.si/stream-options :json "query_result"))
([_ filename-prefix]
{:content-type "application/json; charset=utf-8"
:status 200
:headers {"Content-Disposition" (format "attachment; filename=\"%s_%s.json\""
(or filename-prefix "query_result")
(u.date/format (t/zoned-date-time)))}})) | |
(defmethod qp.si/streaming-results-writer :json
[_ ^OutputStream os]
(let [writer (BufferedWriter. (OutputStreamWriter. os StandardCharsets/UTF_8))
col-names (volatile! nil)
ordered-formatters (volatile! nil)]
(reify qp.si/StreamingResultsWriter
(begin! [_ {{:keys [ordered-cols results_timezone]} :data} viz-settings]
;; TODO -- wouldn't it make more sense if the JSON downloads used `:name` preferentially? Seeing how JSON is
;; probably going to be parsed programmatically
(vreset! col-names (common/column-titles ordered-cols (::mb.viz/column-settings viz-settings)))
(vreset! ordered-formatters (mapv (fn [col]
(formatter/create-formatter results_timezone col viz-settings))
ordered-cols))
(.write writer "[\n"))
(write-row! [_ row row-num _ {:keys [output-order]}]
(let [ordered-row (if output-order
(let [row-v (into [] row)]
(for [i output-order] (row-v i)))
row)]
(when-not (zero? row-num)
(.write writer ",\n"))
(json/generate-stream
(zipmap
@col-names
(map (fn [formatter r]
;; NOTE: Stringification of formatted values ensures consistency with what is shown in the
;; Metabase UI, especially numbers (e.g. percents, currencies, and rounding). However, this
;; does mean that all JSON values are strings. Any other strategy requires some level of
;; inference to know if we should or should not parse a string (or not stringify an object).
(let [res (formatter (common/format-value r))]
(if-some [num-str (:num-str res)]
num-str
res)))
@ordered-formatters ordered-row))
writer)
(.flush writer)))
(finish! [_ _]
(.write writer "\n]")
(.flush writer)
(.flush os)
(.close writer))))) | |
(defmethod qp.si/stream-options :api
([_] (qp.si/stream-options :api nil))
([_ _] {:content-type "application/json; charset=utf-8"})) | |
{:a 100, :b 200} ; -> "a":100,"b":200 | (defn- map->serialized-json-kvs
^String [m]
(when (seq m)
(let [s (json/generate-string m)]
(.substring s 1 (dec (count s)))))) |
(defmethod qp.si/streaming-results-writer :api
[_ ^OutputStream os]
(let [writer (BufferedWriter. (OutputStreamWriter. os StandardCharsets/UTF_8))]
(reify qp.si/StreamingResultsWriter
(begin! [_ _ _]
(.write writer "{\"data\":{\"rows\":[\n"))
(write-row! [_ row row-num _ _]
(when-not (zero? row-num)
(.write writer ",\n"))
(json/generate-stream row writer)
(.flush writer))
(finish! [_ {:keys [data], :as metadata}]
(let [data-kvs-str (map->serialized-json-kvs data)
other-metadata-kvs-str (map->serialized-json-kvs (dissoc metadata :data))]
;; close data.rows
(.write writer "\n]")
;; write any remaining keys in data
(when (seq data-kvs-str)
(.write writer ",\n")
(.write writer data-kvs-str))
;; close data
(.write writer "}")
;; write any remaining top-level keys
(when (seq other-metadata-kvs-str)
(.write writer ",\n")
(.write writer other-metadata-kvs-str))
;; close top-level map
(.write writer "}"))
(.flush writer)
(.flush os)
(.close writer))))) | |
(ns metabase.query-processor.streaming.xlsx
(:require
[cheshire.core :as json]
[clojure.string :as str]
[dk.ative.docjure.spreadsheet :as spreadsheet]
[java-time.api :as t]
[metabase.lib.schema.temporal-bucketing
:as lib.schema.temporal-bucketing]
[metabase.query-processor.streaming.common :as common]
[metabase.query-processor.streaming.interface :as qp.si]
[metabase.shared.models.visualization-settings :as mb.viz]
[metabase.shared.util.currency :as currency]
[metabase.util :as u]
[metabase.util.date-2 :as u.date]
[metabase.util.i18n :refer [tru]])
(:import
(java.io OutputStream)
(java.time LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime ZonedDateTime)
(org.apache.poi.ss.usermodel Cell DataFormat DateUtil Workbook)
(org.apache.poi.ss.util CellRangeAddress)
(org.apache.poi.xssf.streaming SXSSFRow SXSSFSheet SXSSFWorkbook))) | |
(set! *warn-on-reflection* true) | |
+----------------------------------------------------------------------------------------------------------------+ | Format string generation | +----------------------------------------------------------------------------------------------------------------+ | |
If any of these settings are present, we should format the column as a number. | (def ^:private number-setting-keys
#{::mb.viz/number-style
::mb.viz/number-separators
::mb.viz/currency
::mb.viz/currency-style
::mb.viz/currency-in-header
::mb.viz/decimals
::mb.viz/scale
::mb.viz/prefix
::mb.viz/suffix}) |
If any of these settings are present, we should format the column as a date and/or time. | (def ^:private datetime-setting-keys
#{::mb.viz/date-style
::mb.viz/date-separator
::mb.viz/date-abbreviate
::mb.viz/time-enabled
::mb.viz/time-style}) |
Adds a currency to the base format string as either a suffix (for pluralized names) or prefix (for symbols or codes). | (defn- currency-format-string
[base-string format-settings]
(let [currency-code (::mb.viz/currency format-settings "USD")
currency-identifier (common/currency-identifier format-settings)]
(condp = (::mb.viz/currency-style format-settings "symbol")
"symbol"
(if (currency/supports-symbol? currency-code)
(str "[$" currency-identifier "]" base-string)
(str "[$" currency-identifier "] " base-string))
"code"
(str "[$" currency-identifier "] " base-string)
"name"
(str base-string "\" " currency-identifier "\"")))) |
Use default formatting for decimal number types that have no other format settings defined aside from prefix, suffix or scale. | (defn- unformatted-number?
[format-settings]
(and
;; This is a decimal or currency number (not a percentage or scientific notation)
(or (= (::mb.viz/number-style format-settings) "decimal")
(= (::mb.viz/number-style format-settings) "currency")
(not (::mb.viz/number-style format-settings)))
;; Custom number formatting options are not set
(not (seq (dissoc format-settings
::mb.viz/number-style
::mb.viz/number-separators
::mb.viz/scale
::mb.viz/prefix
::mb.viz/suffix))))) |
Returns format strings for a number column corresponding to the given settings. The first value in the returned list should be used for integers, or numbers that round to integers. The second number should be used for all other values. | (defn- number-format-strings
[{::mb.viz/keys [prefix suffix number-style number-separators currency-in-header decimals] :as format-settings}]
(let [format-strings
(let [base-string (if (= number-separators ".")
;; Omit thousands separator if ommitted in the format settings. Otherwise ignore
;; number separator settings, since custom separators are not supported in XLSX.
"###0"
"#,##0")
decimals (or decimals 2)
base-strings (if (unformatted-number? format-settings)
;; [int-format, float-format]
[base-string (str base-string ".##")]
(repeat 2 (apply str base-string (when (> decimals 0) (apply str "." (repeat decimals "0"))))))]
(condp = number-style
"percent"
(map #(str % "%") base-strings)
"scientific"
(map #(str % "E+0") base-strings)
"decimal"
base-strings
(if (and (= number-style "currency")
(false? currency-in-header))
(map #(currency-format-string % format-settings) base-strings)
base-strings)))]
(map
(fn [format-string]
(str
(when prefix (str "\"" prefix "\""))
format-string
(when suffix (str "\"" suffix "\""))))
format-strings))) |
(defn- abbreviate-date-names
[format-settings format-string]
(if (::mb.viz/date-abbreviate format-settings false)
(-> format-string
(str/replace "mmmm" "mmm")
(str/replace "dddd" "ddd"))
format-string)) | |
(defn- replace-date-separators
[format-settings format-string]
(let [separator (::mb.viz/date-separator format-settings "/")]
(str/replace format-string "/" separator))) | |
(defn- time-format
[format-settings]
(let [base-time-format (condp = (::mb.viz/time-enabled format-settings "minutes")
"minutes"
"h:mm"
"seconds"
"h:mm:ss"
"milliseconds"
"h:mm:ss.000"
;; {::mb.viz/time-enabled nil} indicates that time is explicitly disabled, rather than
;; defaulting to "minutes"
nil
nil)]
(when base-time-format
(condp = (::mb.viz/time-style format-settings "h:mm A")
"HH:mm"
(str "h" base-time-format)
;; Deprecated time style which should be already converted to HH:mm when viz settings are
;; normalized, but we'll handle it here too just in case. (#18112)
"k:mm"
(str "h" base-time-format)
"h:mm A"
(str base-time-format " am/pm")
"h A"
"h am/pm")))) | |
Adds the appropriate time setting to a date format string if necessary, producing a datetime format string. | (defn- add-time-format
[format-settings unit format-string]
(if (or (not unit)
(lib.schema.temporal-bucketing/time-bucketing-units unit)
(= :default unit))
(if-let [time-format (time-format format-settings)]
(cond->> time-format
(seq format-string)
(str format-string ", "))
format-string)
format-string)) |
For a given date format, returns the format to use in exports if :unit is :month | (defn- month-style
[date-format]
(case date-format
"m/d/yyyy" "m/yyyy"
"yyyy/m/d" "yyyy/m"
;; Default for all other styles
"mmmm, yyyy")) |
(defn- date-format
[format-settings unit]
(let [base-style (u/lower-case-en (::mb.viz/date-style format-settings "mmmm d, yyyy"))
unit-style (case unit
:month (month-style base-style)
:year "yyyy"
base-style)]
(->> unit-style
(abbreviate-date-names format-settings)
(replace-date-separators format-settings)))) | |
(defn- datetime-format-string
([format-settings]
(datetime-format-string format-settings nil))
([format-settings unit]
(->> (date-format format-settings unit)
(add-time-format format-settings unit)))) | |
Returns a vector of format strings for a datetime column or number column, corresponding to the provided format settings. | (defn- format-settings->format-strings
[format-settings {semantic-type :semantic_type
effective-type :effective_type
base-type :base_type
unit :unit :as col}]
(let [col-type (common/col-type col)]
(u/one-or-many
(cond
;; Primary key or foreign key
(isa? col-type :Relation/*)
"0"
;; This logic is a guard against someone setting the semantic type of a non-temporal value like 1.0 to temporal.
;; It will not apply formatting to the value in this case.
(and (or (some #(contains? datetime-setting-keys %) (keys format-settings))
(isa? semantic-type :type/Temporal))
(or (isa? effective-type :type/Temporal)
(isa? base-type :type/Temporal)))
(datetime-format-string format-settings unit)
(or (some #(contains? number-setting-keys %) (keys format-settings))
(isa? col-type :type/Currency))
(number-format-strings format-settings))))) |
+----------------------------------------------------------------------------------------------------------------+ | XLSX export logic | +----------------------------------------------------------------------------------------------------------------+ | |
(defmethod qp.si/stream-options :xlsx
([_]
(qp.si/stream-options :xlsx "query_result"))
([_ filename-prefix]
{:content-type "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
:write-keepalive-newlines? false
:status 200
:headers {"Content-Disposition" (format "attachment; filename=\"%s_%s.xlsx\""
(or filename-prefix "query_result")
(u.date/format (t/zoned-date-time)))}})) | |
(defn- cell-string-format-style
[^Workbook workbook ^DataFormat data-format format-string]
(doto (.createCellStyle workbook)
(.setDataFormat (. data-format getFormat ^String format-string)))) | |
Compute a sequence of cell styles for each column | (defn- compute-column-cell-styles
[^Workbook workbook ^DataFormat data-format viz-settings cols]
(for [col cols]
(let [settings (common/viz-settings-for-col col viz-settings)
format-strings (format-settings->format-strings settings col)]
(when (seq format-strings)
(map
(partial cell-string-format-style workbook data-format)
format-strings))))) |
Default strings to use for datetime and number fields if custom format settings are not set. | (defn- default-format-strings
[]
{:datetime (datetime-format-string (common/merge-global-settings {} :type/Temporal))
:date (datetime-format-string (common/merge-global-settings {::mb.viz/time-enabled nil} :type/Temporal))
;; Use a fixed format for time fields since time formatting isn't currently supported (#17357)
:time "h:mm am/pm"
:integer "#,##0"
:float "#,##0.##"}) |
Compute default cell styles based on column types | (defn- compute-typed-cell-styles
;; These are tested, but does this happen IRL?
[^Workbook workbook ^DataFormat data-format]
(update-vals
(default-format-strings)
(partial cell-string-format-style workbook data-format))) |
Returns whether a number should be formatted as an integer after being rounded to 2 decimal places. | (defn- rounds-to-int?
[value]
(let [rounded (.setScale (bigdec value) 2 java.math.RoundingMode/HALF_UP)]
(== (bigint rounded) rounded))) |
Sets a cell to the provided value, with an appropriate style if necessary. This is based on the equivalent multimethod in Docjure, but adapted to support Metabase viz settings. | (defmulti ^:private set-cell!
(fn [^Cell _cell value _styles _typed-styles]
(type value))) |
Temporal values in Excel are just NUMERIC cells that are stored in a floating-point format and have some cell styles applied that dictate how to format them | |
(defmethod set-cell! LocalDate [^Cell cell ^LocalDate t styles typed-styles] (.setCellValue cell t) (.setCellStyle cell (or (first styles) (typed-styles :date)))) | |
(defmethod set-cell! LocalDateTime [^Cell cell ^LocalDateTime t styles typed-styles] (.setCellValue cell t) (.setCellStyle cell (or (first styles) (typed-styles :datetime)))) | |
(defmethod set-cell! LocalTime [^Cell cell t styles typed-styles] ;; there's no `.setCellValue` for a `LocalTime` -- but all the built-in impls for `LocalDate` and `LocalDateTime` do ;; anyway is convert the date(time) to an Excel datetime floating-point number and then set that. ;; ;; `DateUtil/convertTime` will convert a *time* string to an Excel number; after that we can set the numeric value ;; directly. ;; ;; See https://poi.apache.org/apidocs/4.1/org/apache/poi/ss/usermodel/DateUtil.html#convertTime-java.lang.String- (.setCellValue cell (DateUtil/convertTime (u.date/format "HH:mm:ss" t))) (.setCellStyle cell (or (first styles) (typed-styles :time)))) | |
(defmethod set-cell! OffsetTime [^Cell cell t styles typed-styles] (set-cell! cell (t/local-time (common/in-result-time-zone t)) styles typed-styles)) | |
(defmethod set-cell! OffsetDateTime [^Cell cell t styles typed-styles] (set-cell! cell (t/local-date-time (common/in-result-time-zone t)) styles typed-styles)) | |
(defmethod set-cell! ZonedDateTime [^Cell cell t styles typed-styles] (set-cell! cell (t/offset-date-time t) styles typed-styles)) | |
(defmethod set-cell! String [^Cell cell value _styles _typed-styles] (.setCellValue cell ^String value)) | |
(defmethod set-cell! Number
[^Cell cell value styles typed-styles]
(let [v (double value)]
(.setCellValue cell v)
;; Do not set formatting for ##NaN, ##Inf, or ##-Inf
(when (u/real-number? v)
(let [[int-style float-style] styles]
(if (rounds-to-int? v)
(.setCellStyle cell (or int-style (typed-styles :integer)))
(.setCellStyle cell (or float-style (typed-styles :float)))))))) | |
(defmethod set-cell! Boolean [^Cell cell value _styles _typed-styles] (.setCellValue cell ^Boolean value)) | |
add a generic implementation for the method that writes values to XLSX cells that just piggybacks off the
implementations we've already defined for encoding things as JSON. These implementations live in
| (defmethod set-cell! Object
[^Cell cell value _styles _typed-styles]
;; stick the object in a JSON map and encode it, which will force conversion to a string. Then unparse that JSON and
;; use the resulting value as the cell's new String value. There might be some more efficient way of doing this but
;; I'm not sure what it is.
(.setCellValue cell (str (-> (json/generate-string {:v value})
(json/parse-string keyword)
:v)))) |
(defmethod set-cell! nil [^Cell cell _value _styles _typed-styles] (.setBlank cell)) | |
When true, XLSX exports will attempt to parse string values into corresponding java.time classes so that formatting can be applied. This should be enabled for generation of pulse/dashboard subscription attachments. | (def ^:dynamic *parse-temporal-string-values* false) |
Adds a row of values to the spreadsheet. Values with the This is based on the equivalent function in Docjure, but adapted to support Metabase viz settings. | (defn- maybe-parse-temporal-value
[value col]
(when (and *parse-temporal-string-values*
(isa? (:effective_type col) :type/Temporal)
(string? value))
(try (u.date/parse value)
;; Fallback to plain string value if it couldn't be parsed
(catch Exception _ value
value))))
(defn- add-row!
[^SXSSFSheet sheet values cols col-settings cell-styles typed-cell-styles]
(let [row-num (if (= 0 (.getPhysicalNumberOfRows sheet))
0
(inc (.getLastRowNum sheet)))
row (.createRow sheet row-num)]
(doseq [[value col styles index] (map vector values cols cell-styles (range (count values)))]
(let [id-or-name (or (:id col) (:name col))
settings (or (get col-settings {::mb.viz/field-id id-or-name})
(get col-settings {::mb.viz/column-name id-or-name}))
scaled-val (if (and value (::mb.viz/scale settings))
(* value (::mb.viz/scale settings))
value)
;; Temporal values are converted into strings in the format-rows QP middleware, which is enabled during
;; dashboard subscription/pulse generation. If so, we should parse them here so that formatting is applied.
parsed-value (or
(maybe-parse-temporal-value value col)
scaled-val)]
(set-cell! (.createCell ^SXSSFRow row ^Integer index) parsed-value styles typed-cell-styles)))
row)) |
The maximum number of rows we should use for auto-sizing. If this number is too large, exports of large datasets will be prohibitively slow. | (def ^:dynamic *auto-sizing-threshold* 100) |
The extra width applied to columns after they have been auto-sized, in units of 1/256 of a character width. This ensures the cells in the header row have enough room for the filter dropdown icon. | (def ^:private extra-column-width (* 4 256)) |
Cap column widths at 255 characters | (def ^:private max-column-width (* 255 256)) |
Adjusts each column to fit its largest value, plus a constant amount of extra padding. | (defn- autosize-columns!
[sheet]
(doseq [i (.getTrackedColumnsForAutoSizing ^SXSSFSheet sheet)]
(.autoSizeColumn ^SXSSFSheet sheet i)
(.setColumnWidth ^SXSSFSheet sheet i (min max-column-width
(+ (.getColumnWidth ^SXSSFSheet sheet i) extra-column-width)))
(.untrackColumnForAutoSizing ^SXSSFSheet sheet i))) |
Turns on auto-filter for the header row, which adds a button to each header cell that allows columns to be filtered and sorted. Also freezes the header row so that it floats above the data. | (defn- setup-header-row!
[sheet col-count]
(when (> col-count 0)
(.setAutoFilter ^SXSSFSheet sheet (new CellRangeAddress 0 0 0 (dec col-count)))
(.createFreezePane ^SXSSFSheet sheet 0 1))) |
(defmethod qp.si/streaming-results-writer :xlsx
[_ ^OutputStream os]
(let [workbook (SXSSFWorkbook.)
sheet (spreadsheet/add-sheet! workbook (tru "Query result"))
data-format (. workbook createDataFormat)
cell-styles (volatile! nil)
typed-cell-styles (volatile! nil)]
(reify qp.si/StreamingResultsWriter
(begin! [_ {{:keys [ordered-cols]} :data} {col-settings ::mb.viz/column-settings :as viz-settings}]
(vreset! cell-styles (compute-column-cell-styles workbook data-format viz-settings ordered-cols))
(vreset! typed-cell-styles (compute-typed-cell-styles workbook data-format))
(doseq [i (range (count ordered-cols))]
(.trackColumnForAutoSizing ^SXSSFSheet sheet i))
(setup-header-row! sheet (count ordered-cols))
(spreadsheet/add-row! sheet (common/column-titles ordered-cols col-settings)))
(write-row! [_ row row-num ordered-cols {:keys [output-order] :as viz-settings}]
(let [ordered-row (if output-order
(let [row-v (into [] row)]
(for [i output-order] (row-v i)))
row)
col-settings (::mb.viz/column-settings viz-settings)]
(add-row! sheet ordered-row ordered-cols col-settings @cell-styles @typed-cell-styles)
(when (= (inc row-num) *auto-sizing-threshold*)
(autosize-columns! sheet))))
(finish! [_ {:keys [row_count]}]
(when (or (nil? row_count) (< row_count *auto-sizing-threshold*))
;; Auto-size columns if we never hit the row threshold, or a final row count was not provided
(autosize-columns! sheet))
(try
(spreadsheet/save-workbook-into-stream! os workbook)
(finally
(.dispose workbook)
(.close os))))))) | |
Functions for fetching the timezone for the current query. | (ns metabase.query-processor.timezone (:require [java-time.api :as t] [metabase.config :as config] [metabase.driver :as driver] [metabase.lib.metadata :as lib.metadata] [metabase.query-processor.store :as qp.store] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log]) (:import (java.time ZonedDateTime))) |
(set! *warn-on-reflection* true) | |
(def ^:private ^:dynamic *report-timezone-id-override* nil) | |
(def ^:private ^:dynamic *database-timezone-id-override* nil) | |
(def ^:private ^:dynamic *results-timezone-id-override* nil) | |
TODO - consider making this | (defn- valid-timezone-id [timezone-id]
(when (and (string? timezone-id)
(seq timezone-id))
(try
(t/zone-id timezone-id)
timezone-id
(catch Throwable _
(log/warn (tru "Invalid timezone ID ''{0}''" timezone-id))
nil)))) |
(defn- report-timezone-id* []
(or *report-timezone-id-override*
(driver/report-timezone))) | |
+----------------------------------------------------------------------------------------------------------------+ | Public Interface | +----------------------------------------------------------------------------------------------------------------+ | |
Timezone ID for the report timezone, if the current driver and database supports it. (If the current driver supports it, this is
bound by the | (defn report-timezone-id-if-supported
(^String []
(report-timezone-id-if-supported driver/*driver* (lib.metadata/database (qp.store/metadata-provider))))
(^String [driver database]
(when (driver/database-supports? driver :set-timezone database)
(valid-timezone-id (report-timezone-id*))))) |
The timezone that the current database is in, as determined by the most recent sync. | (defn database-timezone-id
(^String []
(database-timezone-id ::db-from-store))
(^String [database]
(valid-timezone-id
(or *database-timezone-id-override*
(let [database (if (= database ::db-from-store)
(lib.metadata/database (qp.store/metadata-provider))
database)]
(:timezone database)))))) |
The system timezone of this Metabase instance. | (defn system-timezone-id ^String [] (.. (t/system-clock) getZone getId)) |
The timezone that we would like to run a query in, regardless of whether we are actually able to do so. This is
always equal to the value of the | (defn requested-timezone-id ^String [] (valid-timezone-id (report-timezone-id*))) |
The timezone that a query is actually ran in report timezone, if set and supported by the current driver;
otherwise the timezone of the database (if known), otherwise the system timezone. Guaranteed to always return a
timezone ID never returns | (defn results-timezone-id
(^String []
(results-timezone-id driver/*driver* ::db-from-store))
(^String [database]
(results-timezone-id (:engine database) database))
(^String [driver database & {:keys [use-report-timezone-id-if-unsupported?]
:or {use-report-timezone-id-if-unsupported? false}}]
(valid-timezone-id
(or *results-timezone-id-override*
(if use-report-timezone-id-if-unsupported?
(valid-timezone-id (report-timezone-id*))
(report-timezone-id-if-supported driver database))
;; don't actually fetch DB from store unless needed — that way if `*results-timezone-id-override*` is set we
;; don't need to init a store during tests
(database-timezone-id database)
;; NOTE: if we don't have an explicit report-timezone then use the JVM timezone
;; this ensures alignment between the way dates are processed by JDBC and our returned data
;; GH issues: #2282, #2035
(system-timezone-id))))) |
Get the current moment in time adjusted to the results timezone ID, e.g. for relative datetime calculations. | (def ^ZonedDateTime now
(comp (fn [timezone-id]
(t/with-zone-same-instant (t/zoned-date-time) (t/zone-id timezone-id)))
results-timezone-id)) |
normally I'd do this inline with the | (when config/is-dev? (alter-meta! #'now assoc :arglists (:arglists (meta #'results-timezone-id)))) |
Utility functions used by the global query processor and middleware functions. | (ns metabase.query-processor.util (:require [buddy.core.codecs :as codecs] [buddy.core.hash :as buddy-hash] [cheshire.core :as json] [clojure.string :as str] [medley.core :as m] [metabase.driver :as driver] [metabase.mbql.normalize :as mbql.normalize] [metabase.util :as u] [metabase.util.malli :as mu])) |
(set! *warn-on-reflection* true) | |
TODO - I think most of the functions in this namespace that we don't remove could be moved to [[metabase.mbql.util]] | |
Is the given query an MBQL query without a | (defn query-without-aggregations-or-limits?
[{{aggregations :aggregation, :keys [limit page]} :query}]
(and (not limit)
(not page)
(empty? aggregations))) |
Generates the default query remark. Exists as a separate function so that overrides of the query->remark multimethod can access the default value. | (defn default-query->remark
[{{:keys [executed-by query-hash], :as _info} :info, query-type :type}]
(str "Metabase" (when executed-by
(assert (instance? (Class/forName "[B") query-hash))
(format ":: userID: %s queryType: %s queryHash: %s"
executed-by
(case (keyword query-type)
:query "MBQL"
:native "native")
(codecs/bytes->hex query-hash))))) |
Generate an appropriate remark So this turns your average 10, 20, 30 character query into a 110, 120, 130 etc character query. One leaky-abstraction part of this is that this will confuse the bejeezus out of people who first encounter their passed-through RDBMS error messages. 'Hey, this is a 20 character query! What's it talking about, error at position 120?'
This gets fixed, but in a spooky-action-at-a-distance way, in
| (defmulti query->remark
{:arglists '(^String [driver query])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(defmethod query->remark :default [_ query] (default-query->remark query)) | |
------------------------------------------------- Normalization -------------------------------------------------- | |
TODO - this has been moved to | (mu/defn ^:deprecated normalize-token :- :keyword
"Convert a string or keyword in various cases (`lisp-case`, `snake_case`, or `SCREAMING_SNAKE_CASE`) to a lisp-cased
keyword."
[token :- [:or :keyword :string]]
(-> (name token)
u/lower-case-en
(str/replace #"_" "-")
keyword)) |
---------------------------------------------------- Hashing ----------------------------------------------------- | |
Return | (mu/defn ^:private select-keys-for-hashing
[query :- :map]
(let [{:keys [constraints parameters], :as query} (select-keys query [:database :type :query :native :parameters
:constraints])]
(cond-> query
(empty? constraints) (dissoc :constraints)
(empty? parameters) (dissoc :parameters)))) |
#_{:clj-kondo/ignore [:non-arg-vec-return-type-hint]}
(mu/defn ^"[B" query-hash :- bytes?
"Return a 256-bit SHA3 hash of `query` as a key for the cache. (This is returned as a byte array.)"
[query :- :map]
(buddy-hash/sha3-256 (json/generate-string (select-keys-for-hashing query)))) | |
--------------------------------------------- Query Source Card IDs ---------------------------------------------- | |
Return the ID of the Card used as the "source" query of this query, if applicable; otherwise return | (defn query->source-card-id
^Integer [outer-query]
(let [source-table (get-in outer-query [:query :source-table])]
(when (string? source-table)
(when-let [[_ card-id-str] (re-matches #"^card__(\d+$)" source-table)]
(Integer/parseInt card-id-str))))) |
------------------------------------------- Metadata Combination Utils -------------------------------------------- | |
A standard and repeatable way to address a column. Names can collide and sometimes are not unique. Field refs should be stable, except we have to exclude the last part as extra information can be tucked in there. Names can be non-unique at times, numeric ids are not guaranteed. | (defn field-ref->key [[tyype identifier]] [tyype identifier]) |
Set of FieldOptions that only mattered for identification purposes. | (def field-options-for-identification
;; base-type is required for field that use name instead of id
#{:source-field :join-alias :base-type}) |
(defn- field-normalizer
[field]
(let [[type id-or-name options ] (mbql.normalize/normalize-tokens field)]
[type id-or-name (select-keys options field-options-for-identification)])) | |
Given a field and resultmetadata, return a map of information about the field if resultmetadata contains a matched field. | (defn field->field-info
[field result-metadata]
(let [[_ttype id-or-name options :as field] (field-normalizer field)]
(or
;; try match field_ref first
(first (filter (fn [field-info]
(= field
(-> field-info
:field_ref
field-normalizer)))
result-metadata))
;; if not match name and base type for aggregation or field with string id
(first (filter (fn [field-info]
(and (= (:name field-info)
id-or-name)
(= (:base-type options)
(:base_type field-info))))
result-metadata))))) |
Keys that can survive merging metadata from the database onto metadata computed from the query. When merging metadata, the types returned should be authoritative. But things like semantictype, displayname, and description can be merged on top. | (def preserved-keys ;; TODO: ideally we don't preserve :id but some notion of :user-entered-id or :identified-id [:id :description :display_name :semantic_type :fk_target_field_id :settings :visibility_type]) |
Blend saved metadata from previous runs into fresh metadata from an actual run of the query. Ensure that saved metadata from datasets or source queries can remain in the results metadata. We always recompute
metadata in general, so need to blend the saved metadata on top of the computed metadata. First argument should be
the metadata from a run from the query, and | (defn combine-metadata
[fresh pre-existing]
(let [by-key (m/index-by (comp field-ref->key :field_ref) pre-existing)]
(for [{:keys [field_ref source] :as col} fresh]
(if-let [existing (and (not= :aggregation source)
(get by-key (field-ref->key field_ref)))]
(merge col (select-keys existing preserved-keys))
col)))) |
Walks query and generates appropriate aliases for every selected column; and adds extra keys to the corresponding MBQL clauses with this information. Deduplicates aliases and calls [[metabase.driver/escape-alias]] with the generated aliases. Adds information about the aliases in source queries and joins that correspond to columns in the parent level. This code is currently opt-in, and is currently only used by SQL drivers ([[metabase.driver.sql.query-processor]] manually calls [[add-alias-info]] inside of [[metabase.driver.sql.query-processor/mbql->native]] and [[metabase.driver.mongo.query-processor/mbql->native]]) but at some point in the future this may become general QP middleware that can't be opted out of. [[add-alias-info]] adds some or all of the following keys to every `::source-table`String name, integer Table ID, the keyword
TODO -- consider allowing vectors of multiple qualifiers e.g. `::source-alias`String name to use to refer to this clause during compilation. `::desired-alias`If this clause is 'selected' (i.e., appears in `::position`If this clause is 'selected', this is the position the clause will appear in the results (i.e. the corresponding column index). | (ns metabase.query-processor.util.add-alias-info (:require [clojure.walk :as walk] [medley.core :as m] [metabase.driver :as driver] [metabase.driver.sql.query-processor.deprecated :as sql.qp.deprecated] [metabase.lib.metadata :as lib.metadata] [metabase.lib.schema.common :as lib.schema.common] [metabase.lib.schema.id :as lib.schema.id] [metabase.mbql.schema :as mbql.s] [metabase.mbql.util :as mbql.u] [metabase.query-processor.error-type :as qp.error-type] [metabase.query-processor.store :as qp.store] [metabase.util :as u] [metabase.util.i18n :refer [trs tru]] [metabase.util.malli :as mu])) |
Generate a field alias by applying | (defn prefix-field-alias [prefix field-alias] (driver/escape-alias driver/*driver* (str prefix "__" field-alias))) |
Creates a function with the signature (unique-alias position original-alias) To return a uniquified version of | (defn- make-unique-alias-fn
[]
(let [unique-name-fn (mbql.u/unique-name-generator
;; some databases treat aliases as case-insensitive so make sure the generated aliases are
;; unique regardless of case
:name-key-fn u/lower-case-en
;; TODO -- we should probably limit the length somehow like we do in
;; [[metabase.query-processor.middleware.add-implicit-joins/join-alias]], and also update this
;; function and that one to append a short suffix if we are limited by length. See also
;; [[driver/escape-alias]]
:unique-alias-fn (fn [original suffix]
(driver/escape-alias driver/*driver* (str original \_ suffix))))]
(fn unique-alias-fn [position original-alias]
(unique-name-fn position (driver/escape-alias driver/*driver* original-alias))))) |
TODO -- this should probably limit the resulting alias, and suffix a short hash as well if it gets too long. See also [[unique-alias-fn]] below. | |
(defn- remove-namespaced-options [options]
(when options
(not-empty (into {}
(remove (fn [[k _]]
(when (keyword? k)
(namespace k))))
options)))) | |
Normalize a | (defn normalize-clause
[clause]
(mbql.u/match-one clause
;; optimization: don't need to rewrite a `:field` clause without any options
[:field _ nil]
&match
[:field id-or-name opts]
;; this doesn't use [[mbql.u/update-field-options]] because this gets called a lot and the overhead actually adds up
;; a bit
[:field id-or-name (remove-namespaced-options (cond-> (dissoc opts :source-field :effective-type)
(integer? id-or-name) (dissoc :base-type)))]
;; for `:expression` and `:aggregation` references, remove the options map if they are empty.
[:expression expression-name opts]
(if-let [opts (remove-namespaced-options opts)]
[:expression expression-name opts]
[:expression expression-name])
[:aggregation index opts]
(if-let [opts (remove-namespaced-options opts)]
[:aggregation index opts]
[:aggregation index])
_
&match)) |
Get all the clauses that are returned by this level of the query as a map of normalized-clause -> index of that column in the results. | (defn- selected-clauses
[{:keys [fields breakout aggregation], :as query}]
;; this is cached for the duration of the QP run because it's a little expensive to calculate and caching this speeds
;; up this namespace A LOT
(qp.store/cached (select-keys query [:fields :breakout :aggregation])
(into
{}
(comp cat
(map-indexed
(fn [i clause]
[(normalize-clause clause) i])))
[breakout
(map-indexed
(fn [i ag]
(mbql.u/replace ag
[:aggregation-options wrapped opts]
[:aggregation i]
;; aggregation clause should be preprocessed into an `:aggregation-options` clause by now.
_
(throw (ex-info (tru "Expected :aggregation-options clause, got {0}" (pr-str ag))
{:type qp.error-type/qp, :clause ag}))))
aggregation)
fields]))) |
Get the position (i.e., column index) | (defn- clause->position [inner-query clause] ((selected-clauses inner-query) (normalize-clause clause))) |
(defn- this-level-join-aliases [{:keys [joins]}]
(into #{} (map :alias) joins)) | |
(defn- field-is-from-join-in-this-level? [inner-query [_field _id-or-name {:keys [join-alias]}]]
(when join-alias
((this-level-join-aliases inner-query) join-alias))) | |
(mu/defn ^:private field-instance :- [:maybe lib.metadata/ColumnMetadata]
[[_ id-or-name :as _field-clause] :- mbql.s/field]
(when (integer? id-or-name)
(lib.metadata/field (qp.store/metadata-provider) id-or-name))) | |
(defn- field-table-id [field-clause] (:table-id (field-instance field-clause))) | |
(mu/defn ^:private field-source-table-alias :- [:or
::lib.schema.common/non-blank-string
::lib.schema.id/table
[:= ::source]]
"Determine the appropriate `::source-table` alias for a `field-clause`."
[{:keys [source-table source-query], :as inner-query} [_ _id-or-name {:keys [join-alias]}, :as field-clause]]
(let [table-id (field-table-id field-clause)
join-is-this-level? (field-is-from-join-in-this-level? inner-query field-clause)]
(cond
join-is-this-level? join-alias
(and table-id (= table-id source-table)) table-id
source-query ::source
:else
(throw (ex-info (trs "Cannot determine the source table or query for Field clause {0}" (pr-str field-clause))
{:type qp.error-type/invalid-query
:clause field-clause
:query inner-query}))))) | |
(defn- exports [query]
(into #{} (mbql.u/match (dissoc query :source-query :source-metadata :joins)
[(_ :guard #{:field :expression :aggregation-options}) _ (_ :guard (every-pred map? ::position))]))) | |
(defn- join-with-alias [{:keys [joins]} join-alias]
(some (fn [join]
(when (= (:alias join) join-alias)
join))
joins)) | |
(defn- fuzzify [clause] (mbql.u/update-field-options clause dissoc :temporal-unit :binning)) | |
(defn- field-signature [field-clause] [(second field-clause) (get-in field-clause [2 :join-alias])]) | |
(defn- matching-field-in-source-query*
[source-query source-metadata field-clause & {:keys [normalize-fn]
:or {normalize-fn normalize-clause}}]
(let [normalized (normalize-fn field-clause)
all-exports (exports source-query)
field-exports (filter (partial mbql.u/is-clause? :field)
all-exports)]
;; first look for an EXACT match in the `exports`
(or (m/find-first (fn [a-clause]
(= (normalize-fn a-clause) normalized))
field-exports)
;; if there is no EXACT match, attempt a 'fuzzy' match by disregarding the `:temporal-unit` and `:binning`
(let [fuzzy-normalized (fuzzify normalized)]
(m/find-first (fn [a-clause]
(= (fuzzify (normalize-fn a-clause)) fuzzy-normalized))
field-exports))
;; if still no match try looking based for a matching Field based on ID.
(let [[_field id-or-name _opts] field-clause]
(when (integer? id-or-name)
(m/find-first (fn [[_field an-id-or-name _opts]]
(= an-id-or-name id-or-name))
field-exports)))
;; look for a matching expression clause with the same name if still no match
(when-let [field-name (let [[_ id-or-name] field-clause]
(when (string? id-or-name)
id-or-name))]
(or (m/find-first (fn [[_ expression-name :as _expression-clause]]
(= expression-name field-name))
(filter (partial mbql.u/is-clause? :expression) all-exports))
(m/find-first (fn [[_ _ opts :as _aggregation-options-clause]]
(= (::source-alias opts) field-name))
(filter (partial mbql.u/is-clause? :aggregation-options) all-exports))))
;; look for a field referenced by the name in source-metadata
(let [field-name (second field-clause)]
(when (string? field-name)
(when-let [column (m/find-first #(= (:name %) field-name) source-metadata)]
(let [signature (field-signature (:field_ref column))]
(m/find-first #(= (field-signature %) signature) field-exports)))))))) | |
If | (defn- matching-field-in-join-at-this-level
[inner-query [_ _ {:keys [join-alias]} :as field-clause]]
(when join-alias
(let [{:keys [source-query source-metadata]} (join-with-alias inner-query join-alias)]
(when source-query
(matching-field-in-source-query*
source-query
source-metadata
field-clause
:normalize-fn #(mbql.u/update-field-options (normalize-clause %) dissoc :join-alias)))))) |
If | (defn- field-alias-in-join-at-this-level
[inner-query field-clause]
(when-let [[_ _ {::keys [desired-alias]}] (matching-field-in-join-at-this-level inner-query field-clause)]
desired-alias)) |
(defn- matching-field-in-source-query
[{:keys [source-query source-metadata], :as inner-query} field-clause]
(when (and source-query
(= (field-source-table-alias inner-query field-clause) ::source))
(matching-field-in-source-query* source-query source-metadata field-clause))) | |
(defn- field-alias-in-source-query
[inner-query field-clause]
(when-let [[_ _ {::keys [desired-alias]}] (matching-field-in-source-query inner-query field-clause)]
desired-alias)) | |
Generate a reference for the field instance DEPRECATED: Implement [[field-reference-mlv2]] instead, which accepts a | (defmulti ^String field-reference
{:added "0.46.0", :arglists '([driver field-inst]), :deprecated "0.48.0"}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
Generate a reference for the field instance | (defmulti ^String field-reference-mlv2
{:added "0.48.0", :arglists '([driver field-inst])}
driver/dispatch-on-initialized-driver
:hierarchy #'driver/hierarchy) |
(mu/defmethod field-reference-mlv2 ::driver/driver
[driver :- :keyword
field :- lib.metadata/ColumnMetadata]
#_{:clj-kondo/ignore [:deprecated-var]}
(if (get-method field-reference driver)
(do
(sql.qp.deprecated/log-deprecation-warning
driver
`field-reference
"0.48.0")
(field-reference driver
#_{:clj-kondo/ignore [:deprecated-var]}
(qp.store/->legacy-metadata field)))
(:name field))) | |
Actual name of a | (defn- field-name
[_inner-query [_ id-or-name :as field-clause]]
(or (some->> field-clause
field-instance
(field-reference-mlv2 driver/*driver*))
(when (string? id-or-name)
id-or-name))) |
Calculate extra stuff about | (defn- expensive-field-info
[inner-query field-clause]
{:field-name (field-name inner-query field-clause)
:join-is-this-level? (field-is-from-join-in-this-level? inner-query field-clause)
:alias-from-join (field-alias-in-join-at-this-level inner-query field-clause)
:alias-from-source-query (field-alias-in-source-query inner-query field-clause)}) |
Determine the appropriate | (defn- field-source-alias
{:arglists '([inner-query field-clause expensive-field-info])}
[{:keys [_source-table], :as _inner-query}
[_ _id-or-name {:keys [join-alias]}, :as _field-clause]
{:keys [field-name join-is-this-level? alias-from-join alias-from-source-query]}]
(cond
;; TODO -- this just recalculates the info instead of actually finding the Field in the join and getting its desired
;; alias there... this seems like a clear bug since it doesn't go thru the uniquify logic. Something will
;; potentially break by doing this. I haven't been able to reproduce it yet however.
;;
;; This will only be triggered if the join somehow exposes duplicate columns or columns that have the same escaped
;; name after going thru [[driver/escape-alias]]. I think the only way this could happen is if we escape them
;; aggressively but the escape logic produces duplicate columns (i.e., there is overlap between the unique hashes we
;; suffix to escaped identifiers.)
;;
;; We'll have to look into this more in the future. For now, it seems to work for everything we try it with.
(and join-is-this-level? alias-from-join) alias-from-join
alias-from-source-query alias-from-source-query
(and join-alias (not join-is-this-level?)) (prefix-field-alias join-alias field-name)
:else field-name)) |
Determine the appropriate | (defn- field-desired-alias
{:arglists '([inner-query field-clause expensive-field-info])}
[_inner-query
[_ _id-or-name {:keys [join-alias]} :as _field-clause]
{:keys [field-name alias-from-join alias-from-source-query]}]
(cond
join-alias (prefix-field-alias join-alias (or alias-from-join field-name))
alias-from-source-query alias-from-source-query
:else field-name)) |
(defmulti ^:private clause-alias-info
{:arglists '([inner-query unique-alias-fn clause])}
(fn [_ _ [clause-type]]
clause-type)) | |
(defmethod clause-alias-info :field
[inner-query unique-alias-fn field-clause]
(let [expensive-info (expensive-field-info inner-query field-clause)]
(merge {::source-table (field-source-table-alias inner-query field-clause)
::source-alias (field-source-alias inner-query field-clause expensive-info)}
(when-let [position (clause->position inner-query field-clause)]
{::desired-alias (unique-alias-fn position (field-desired-alias inner-query field-clause expensive-info))
::position position})))) | |
(defmethod clause-alias-info :aggregation
[{aggregations :aggregation, :as inner-query} unique-alias-fn [_ index _opts :as ag-ref-clause]]
(let [position (clause->position inner-query ag-ref-clause)]
;; an aggregation is ALWAYS returned, so it HAS to have a `position`. If it does not, the aggregation reference
;; is busted.
(when-not position
(throw (ex-info (tru "Aggregation does not exist at index {0}" index)
{:type qp.error-type/invalid-query
:clause ag-ref-clause
:query inner-query})))
(let [[_ _ {ag-name :name} :as matching-ag] (nth aggregations index)]
;; make sure we have an `:aggregation-options` clause like we expect. This is mostly a precondition check
;; since we should never be running this code on not-preprocessed queries, so it's not i18n'ed
(when-not (mbql.u/is-clause? :aggregation-options matching-ag)
(throw (ex-info (format "Expected :aggregation-options, got %s. (Query must be fully preprocessed.)"
(pr-str matching-ag))
{:clause ag-ref-clause, :query inner-query})))
{::desired-alias (unique-alias-fn position ag-name)
::position position}))) | |
(defmethod clause-alias-info :expression
[inner-query unique-alias-fn [_ expression-name :as expression-ref-clause]]
(when-let [position (clause->position inner-query expression-ref-clause)]
{::desired-alias (unique-alias-fn position expression-name)
::position position})) | |
(defn- add-info-to-aggregation-definition
[inner-query unique-alias-fn [_ wrapped-ag-clause {original-ag-name :name, :as opts}, :as _ag-clause] ag-index]
(let [position (clause->position inner-query [:aggregation ag-index])
unique-alias (unique-alias-fn position original-ag-name)]
[:aggregation-options wrapped-ag-clause (assoc opts
:name unique-alias
::source-alias original-ag-name
::position position
::desired-alias unique-alias)])) | |
(defn- add-info-to-aggregation-definitions [{aggregations :aggregation, :as inner-query} unique-alias-fn]
(cond-> inner-query
(seq aggregations)
(update :aggregation (fn [aggregations]
(into
[]
(map-indexed (fn [i aggregation]
(add-info-to-aggregation-definition inner-query unique-alias-fn aggregation i)))
aggregations))))) | |
(defn- add-alias-info* [inner-query]
(assert (not (:strategy inner-query)) "add-alias-info* should not be called on a join") ; not user-facing
(let [unique-alias-fn (make-unique-alias-fn)]
(-> (mbql.u/replace inner-query
;; don't rewrite anything inside any source queries or source metadata.
(_ :guard (constantly (some (partial contains? (set &parents))
[:source-query :source-metadata])))
&match
#{:field :aggregation :expression}
(mbql.u/update-field-options &match merge (clause-alias-info inner-query unique-alias-fn &match)))
(add-info-to-aggregation-definitions unique-alias-fn)))) | |
Add extra info to Adds some or all of the following keys: `::source-table`String name, integer Table ID, or the keyword `::source-alias`String name to use to refer to this clause during compilation. `::desired-alias`If this clause is 'selected' (i.e., appears in `::position`If this clause is 'selected', this is the position the clause will appear in the results (i.e. the corresponding column index). | (defn add-alias-info
[query-or-inner-query]
(walk/postwalk
(fn [form]
(if (and (map? form)
((some-fn :source-query :source-table) form)
(not (:strategy form)))
(vary-meta (add-alias-info* form) assoc ::transformed true)
form))
query-or-inner-query)) |
Utility functions for raising/nesting parts of MBQL queries. Currently, this only has [[nest-expressions]], but in the future hopefully we can generalize this a bit so we can do more things that require us to introduce another level of nesting, e.g. support window functions. (This namespace is here rather than in the shared MBQL lib because it relies on other QP-land utils like the QP refs stuff.) | (ns metabase.query-processor.util.nest-query
(:require
[clojure.walk :as walk]
[medley.core :as m]
[metabase.api.common :as api]
[metabase.lib.metadata :as lib.metadata]
[metabase.mbql.util :as mbql.u]
[metabase.plugins.classloader :as classloader]
[metabase.query-processor.middleware.annotate :as annotate]
[metabase.query-processor.middleware.resolve-joins
:as qp.middleware.resolve-joins]
[metabase.query-processor.store :as qp.store]
[metabase.query-processor.util.add-alias-info :as add]
[metabase.util :as u])) |
(defn- joined-fields [inner-query]
(m/distinct-by
add/normalize-clause
(mbql.u/match (walk/prewalk (fn [x]
(if (map? x)
(dissoc x :source-query :source-metadata)
x))
inner-query)
[:field _ (_ :guard :join-alias)]
&match))) | |
(defn- keep-source+alias-props [field] (update field 2 select-keys [::add/source-alias ::add/source-table :join-alias])) | |
(defn- nfc-root [[_ field-id]]
(when-let [field (and (int? field-id)
(lib.metadata/field (qp.store/metadata-provider) field-id))]
(when-let [nfc-root (first (:nfc-path field))]
{:table_id (:table-id field)
:name nfc-root}))) | |
(defn- field-id-props [[_ field-id]]
(when-let [field (and (int? field-id)
(lib.metadata/field (qp.store/metadata-provider) field-id))]
{:table_id (:table-id field)
:name (:name field)})) | |
(defn- remove-unused-fields [inner-query source]
(let [used-fields (-> #{}
(into (map keep-source+alias-props) (mbql.u/match inner-query :field))
(into (map keep-source+alias-props) (mbql.u/match inner-query :expression)))
nfc-roots (into #{} (keep nfc-root) used-fields)]
(update source :fields (fn [fields]
(filterv #(or (-> % keep-source+alias-props used-fields)
(-> % field-id-props nfc-roots))
fields))))) | |
(defn- nest-source [inner-query]
(classloader/require 'metabase.query-processor)
(let [filter-clause (:filter inner-query)
keep-filter? (nil? (mbql.u/match-one filter-clause :expression))
source (as-> (select-keys inner-query [:source-table :source-query :source-metadata :joins :expressions]) source
;; preprocess this without a current user context so it's not subject to permissions checks. To get
;; here in the first place we already had to do perms checks to make sure the query we're transforming
;; is itself ok, so we don't need to run another check
(binding [api/*current-user-id* nil]
((resolve 'metabase.query-processor/preprocess)
{:database (u/the-id (lib.metadata/database (qp.store/metadata-provider)))
:type :query
:query source}))
(add/add-alias-info source)
(:query source)
(dissoc source :limit)
(qp.middleware.resolve-joins/append-join-fields-to-fields source (joined-fields inner-query))
(remove-unused-fields inner-query source)
(cond-> source
keep-filter? (assoc :filter filter-clause)))]
(-> inner-query
(dissoc :source-table :source-metadata :joins)
(assoc :source-query source)
(cond-> keep-filter? (dissoc :filter))))) | |
Convert an | (defn- raise-source-query-expression-ref
[{:keys [source-query], :as query} [_ expression-name opts :as _clause]]
(let [expression-definition (mbql.u/expression-with-name query expression-name)
{base-type :base_type} (some-> expression-definition annotate/infer-expression-type)
{::add/keys [desired-alias]} (mbql.u/match-one source-query
[:expression (_ :guard (partial = expression-name)) source-opts]
source-opts)]
[:field
(or desired-alias expression-name)
(assoc opts :base-type (or base-type :type/*))])) |
(defn- rewrite-fields-and-expressions [query]
(mbql.u/replace query
;; don't rewrite anything inside any source queries or source metadata.
(_ :guard (constantly (some (partial contains? (set &parents))
[:source-query :source-metadata])))
&match
:expression
(raise-source-query-expression-ref query &match)
;; mark all Fields at the new top level as `:qp/ignore-coercion` so QP implementations know not to apply coercion or
;; whatever to them a second time.
[:field _id-or-name (_opts :guard (every-pred :temporal-unit (complement :qp/ignore-coercion)))]
(recur (mbql.u/update-field-options &match assoc :qp/ignore-coercion true))
[:field id-or-name (opts :guard :join-alias)]
(let [{::add/keys [desired-alias]} (mbql.u/match-one (:source-query query)
[:field
(_ :guard (partial = id-or-name))
(matching-opts :guard #(= (:join-alias %) (:join-alias opts)))]
matching-opts)]
[:field id-or-name (cond-> opts
desired-alias (assoc ::add/source-alias desired-alias
::add/desired-alias desired-alias))])
;; when recursing into joins use the refs from the parent level.
(m :guard (every-pred map? :joins))
(let [{:keys [joins]} m]
(-> (dissoc m :joins)
rewrite-fields-and-expressions
(assoc :joins (mapv (fn [join]
(assoc join :qp/refs (:qp/refs query)))
joins)))))) | |
Pushes the | (defn nest-expressions
[query]
(let [{:keys [expressions], :as query} (m/update-existing query :source-query nest-expressions)]
(if (empty? expressions)
query
(let [{:keys [source-query], :as query} (nest-source query)
query (rewrite-fields-and-expressions query)
source-query (assoc source-query :expressions expressions)]
(-> query
(dissoc :source-query :expressions)
(assoc :source-query source-query)
add/add-alias-info))))) |
(ns metabase.query-processor.util.persisted-cache (:require [metabase.driver :as driver] [metabase.driver.ddl.interface :as ddl.i] [metabase.driver.sql.util :as sql.u] [metabase.driver.util :as driver.u] [metabase.lib.schema.id :as lib.schema.id] [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.models.persisted-info :as persisted-info] [metabase.public-settings :as public-settings] [metabase.util.malli :as mu])) | |
Taking a card and a persisted-info record (possibly nil), returns whether the card's query can be substituted for a persisted version. | (mu/defn can-substitute?
[card :- ::lib.schema.metadata/card
persisted-info :- [:maybe ::lib.schema.metadata/persisted-info]]
(and persisted-info
persisted-info/*allow-persisted-substitution*
(:active persisted-info)
(= (:state persisted-info) "persisted")
(:definition persisted-info)
(:query-hash persisted-info)
(= (:query-hash persisted-info) (persisted-info/query-hash (:dataset-query card)))
(= (:definition persisted-info)
(persisted-info/metadata->definition (:result-metadata card)
(:table-name persisted-info))))) |
Returns a native query that selects from the persisted cached table from | (mu/defn persisted-info-native-query
[database-id :- ::lib.schema.id/database
{:keys [table-name] :as _persisted-info} :- ::lib.schema.metadata/persisted-info]
(let [driver (or driver/*driver* (driver.u/database->driver database-id))]
;; select * because we don't actually know the name of the fields when in the actual query. See #28902
(format "select * from %s.%s"
(sql.u/quote-name
driver
:table
(ddl.i/schema-name {:id database-id} (public-settings/site-uuid)))
(sql.u/quote-name
driver
:table
table-name)))) |
(ns metabase.query-processor.util.tag-referenced-cards (:require [metabase.lib.metadata :as lib.metadata] [metabase.lib.metadata.protocols :as lib.metadata.protocols] [metabase.query-processor.store :as qp.store] [metabase.util.i18n :refer [tru]] [metabase.util.malli :as mu])) | |
(defn- query->template-tags [query] (vals (get-in query [:native :template-tags]))) | |
Returns the card IDs from the template tags of the native query of | (defn query->tag-card-ids [query] (keep :card-id (query->template-tags query))) |
(mu/defn tags-referenced-cards :- [:maybe [:sequential lib.metadata/CardMetadata]]
"Returns Card instances referenced by the given native `query`."
[query]
(mapv
(fn [card-id]
(if-let [card (lib.metadata.protocols/card (qp.store/metadata-provider) card-id)]
card
(throw (ex-info (tru "Referenced question #{0} could not be found" (str card-id))
{:card-id card-id}))))
(query->tag-card-ids query))) | |
Code for executing writeback queries. | (ns metabase.query-processor.writeback (:require [metabase.driver :as driver] [metabase.query-processor :as qp] [metabase.query-processor.error-type :as qp.error-type] [metabase.query-processor.middleware.parameters :as parameters] [metabase.query-processor.middleware.permissions :as qp.perms] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.log :as log])) |
Middleware that happens after compilation, AROUND query execution itself. Has the form (f (f query rff context)) -> (f query rff context) | (def ^:private execution-middleware [#'qp.perms/check-query-action-permissions]) |
(defn- apply-middleware [qp middleware-fns]
(reduce
(fn [qp middleware]
(if middleware
(middleware qp)
qp))
qp
middleware-fns)) | |
(defn- writeback-qp []
;; `rff` and `context` are not currently used by the writeback QP stuff, so these parameters can be ignored; we pass
;; in `nil` for these below.
(letfn [(qp* [query _rff _context]
(let [query (parameters/substitute-parameters query)]
;; ok, now execute the query.
(log/debugf "Executing query\n\n%s" (u/pprint-to-str query))
(driver/execute-write-query! driver/*driver* query)))]
(apply-middleware qp* (concat execution-middleware qp/around-middleware)))) | |
Execute an writeback query from an action. | (defn execute-write-query!
[{query-type :type, :as query}]
;; make sure this is a native query.
(when-not (= query-type :native)
(throw (ex-info (tru "Only native queries can be executed as write queries.")
{:type qp.error-type/invalid-query, :status-code 400, :query query})))
((writeback-qp) query nil nil)) |
Execute a write query in SQL against a database given by | (defn execute-write-sql!
[db-id sql-or-sql+params]
(if (sequential? sql-or-sql+params)
(let [[sql & params] sql-or-sql+params]
(execute-write-query! {:type :native
:database db-id
:native {:query sql
:params params}}))
(execute-write-query! {:type :native
:database db-id
:native {:query sql-or-sql+params}}))) |
Related entities recommendations. | (ns metabase.related (:require [clojure.set :as set] [medley.core :as m] [metabase.api.common :as api] [metabase.mbql.normalize :as mbql.normalize] [metabase.models.card :refer [Card]] [metabase.models.collection :refer [Collection]] [metabase.models.dashboard :refer [Dashboard]] [metabase.models.dashboard-card :refer [DashboardCard]] [metabase.models.field :refer [Field]] [metabase.models.interface :as mi] [metabase.models.metric :refer [Metric]] [metabase.models.query :refer [Query]] [metabase.models.segment :refer [Segment]] [metabase.models.table :refer [Table]] [metabase.query-processor.util :as qp.util] [schema.core :as s] [toucan2.core :as t2])) |
(def ^:private ^Long max-best-matches 3)
(def ^:private ^Long max-serendipity-matches 2)
(def ^:private ^Long max-matches (+ max-best-matches
max-serendipity-matches)) | |
(def ^:private ContextBearingForm
[(s/one (s/constrained (s/cond-pre s/Str s/Keyword)
(comp #{:field :metric :segment}
qp.util/normalize-token))
"head")
s/Any]) | |
(defn- collect-context-bearing-forms
[form]
(let [form (mbql.normalize/normalize-fragment [:query :filter] form)]
(into #{}
(comp (remove (s/checker ContextBearingForm))
(map #(update % 0 qp.util/normalize-token)))
(tree-seq sequential? identity form)))) | |
Return the relevant parts of a given entity's definition. Relevant parts are those that carry semantic meaning, and especially context-bearing forms. | (defmulti definition
{:arglists '([instance])}
mi/model) |
(defmethod definition Card
[card]
(-> card
:dataset_query
:query
((juxt :breakout :aggregation :expressions :fields)))) | |
(defmethod definition Metric [metric] (-> metric :definition ((juxt :aggregation :filter)))) | |
(defmethod definition Segment [segment] (-> segment :definition :filter)) | |
(defmethod definition Field [field] [[:field-id (:id field)]]) | |
How similar are entities | (defn- similarity
[a b]
(let [context-a (-> a definition collect-context-bearing-forms)
context-b (-> b definition collect-context-bearing-forms)]
(/ (count (set/intersection context-a context-b))
(max (min (count context-a) (count context-b)) 1)))) |
(defn- rank-by-similarity
[reference entities]
(->> entities
(remove #{reference})
(map #(assoc % :similarity (similarity reference %)))
(sort-by :similarity >))) | |
Create an interesting mix of matches. The idea is to have a balanced mix between close (best) matches and more diverse matches to cover a wider field of intents. | (defn- interesting-mix
[matches]
(let [[best rest] (split-at max-best-matches matches)]
(concat best (->> rest shuffle (take max-serendipity-matches))))) |
(def ^:private ^{:arglists '([instances])} filter-visible
(partial filter (fn [{:keys [archived visibility_type active] :as instance}]
(and (some? instance)
(or (nil? visibility_type)
(= (qp.util/normalize-token visibility_type) :normal))
(not archived)
(not= active false)
(mi/can-read? instance))))) | |
(defn- metrics-for-table
[table]
(filter-visible (t2/select Metric
:table_id (:id table)
:archived false))) | |
(defn- segments-for-table
[table]
(filter-visible (t2/select Segment
:table_id (:id table)
:archived false))) | |
(defn- linking-to
[table]
(->> (t2/select-fn-set :fk_target_field_id Field
:table_id (:id table)
:fk_target_field_id [:not= nil]
:active true)
(map (comp (partial t2/select-one Table :id)
:table_id
(partial t2/select-one Field :id)))
distinct
filter-visible
(take max-matches))) | |
(defn- linked-from
[table]
(if-let [fields (not-empty (t2/select-fn-set :id Field
:table_id (:id table)
:active true))]
(->> (t2/select-fn-set :table_id Field
:fk_target_field_id [:in fields]
:active true)
(map (partial t2/select-one Table :id))
filter-visible
(take max-matches))
[])) | |
(defn- cards-sharing-dashboard
[card]
(if-let [dashboards (not-empty (t2/select-fn-set :dashboard_id DashboardCard
:card_id (:id card)))]
(->> (t2/select-fn-set :card_id DashboardCard
:dashboard_id [:in dashboards]
:card_id [:not= (:id card)])
(map (partial t2/select-one Card :id))
filter-visible
(take max-matches))
[])) | |
(defn- similar-questions
[card]
(->> (t2/select Card
:table_id (:table_id card)
:archived false)
filter-visible
(rank-by-similarity card)
(filter (comp pos? :similarity)))) | |
(defn- canonical-metric
[card]
(->> (t2/select Metric
:table_id (:table_id card)
:archived false)
filter-visible
(m/find-first (comp #{(-> card :dataset_query :query :aggregation)}
:aggregation
:definition)))) | |
(defn- recently-modified-dashboards
[]
(when-let [dashboard-ids (not-empty (t2/select-fn-set :model_id 'Revision
:model "Dashboard"
:user_id api/*current-user-id*
{:order-by [[:timestamp :desc]]}))]
(->> (t2/select Dashboard :id [:in dashboard-ids])
filter-visible
(take max-serendipity-matches)))) | |
(defn- recommended-dashboards
[cards]
(let [recent (recently-modified-dashboards)
card-id->dashboard-cards (->> (apply t2/select [DashboardCard :card_id :dashboard_id]
(cond-> []
(seq cards)
(concat [:card_id [:in (map :id cards)]])
(seq recent)
(concat [:dashboard_id [:not-in (map :id recent)]])))
(group-by :card_id))
dashboard-ids (->> (map :id cards)
(mapcat card-id->dashboard-cards)
(map :dashboard_id)
distinct)
best (when (seq dashboard-ids)
(->> (t2/select Dashboard :id [:in dashboard-ids])
filter-visible
(take max-best-matches)))]
(concat best recent))) | |
(defn- recommended-collections
[cards]
(->> cards
(m/distinct-by :collection_id)
interesting-mix
(keep (comp (partial t2/select-one Collection :id) :collection_id))
filter-visible)) | |
Return related entities. | (defmulti related
{:arglists '([entity])}
mi/model) |
(defmethod related Card
[card]
(let [table (t2/select-one Table :id (:table_id card))
similar-questions (similar-questions card)]
{:table table
:metrics (->> table
metrics-for-table
(rank-by-similarity card)
interesting-mix)
:segments (->> table
segments-for-table
(rank-by-similarity card)
interesting-mix)
:dashboard-mates (cards-sharing-dashboard card)
:similar-questions (interesting-mix similar-questions)
:canonical-metric (canonical-metric card)
:dashboards (recommended-dashboards similar-questions)
:collections (recommended-collections similar-questions)})) | |
(defmethod related Query [query] (related (mi/instance Card query))) | |
(defmethod related Metric
[metric]
(let [table (t2/select-one Table :id (:table_id metric))]
{:table table
:metrics (->> table
metrics-for-table
(rank-by-similarity metric)
interesting-mix)
:segments (->> table
segments-for-table
(rank-by-similarity metric)
interesting-mix)})) | |
(defmethod related Segment
[segment]
(let [table (t2/select-one Table :id (:table_id segment))]
{:table table
:metrics (->> table
metrics-for-table
(rank-by-similarity segment)
interesting-mix)
:segments (->> table
segments-for-table
(rank-by-similarity segment)
interesting-mix)
:linked-from (linked-from table)})) | |
(defmethod related Table
[table]
(let [linking-to (linking-to table)
linked-from (linked-from table)]
{:segments (segments-for-table table)
:metrics (metrics-for-table table)
:linking-to linking-to
:linked-from linked-from
:tables (->> (t2/select Table
:db_id (:db_id table)
:schema (:schema table)
:id [:not= (:id table)]
:visibility_type nil
:active true)
(remove (set (concat linking-to linked-from)))
filter-visible
interesting-mix)})) | |
(defmethod related Field
[field]
(let [table (t2/select-one Table :id (:table_id field))]
{:table table
:segments (->> table
segments-for-table
(rank-by-similarity field)
interesting-mix)
:metrics (->> table
metrics-for-table
(rank-by-similarity field)
(filter (comp pos? :similarity))
interesting-mix)
:fields (->> (t2/select Field
:table_id (:id table)
:id [:not= (:id field)]
:visibility_type "normal"
:active true)
filter-visible
interesting-mix)})) | |
(defmethod related Dashboard
[dashboard]
(let [cards (map (partial t2/select-one Card :id) (t2/select-fn-set :card_id DashboardCard
:dashboard_id (:id dashboard)))]
{:cards (->> cards
(mapcat (comp similar-questions))
(remove (set cards))
distinct
filter-visible
interesting-mix)})) | |
(ns metabase.sample-data (:require [clojure.java.io :as io] [clojure.string :as str] [metabase.models.database :refer [Database]] [metabase.plugins :as plugins] [metabase.sync :as sync] [metabase.util.files :as u.files] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [ring.util.codec :as codec] [toucan2.core :as t2]) (:import (java.net URL))) | |
(set! *warn-on-reflection* true) | |
(def ^:private ^String sample-database-name "Sample Database") (def ^:private ^String sample-database-filename "sample-database.db.mv.db") | |
Reuse the plugins directory for the destination to extract the sample database because it's pretty much guaranteed to exist and be writable. | (defn- target-path [] (u.files/append-to-path (plugins/plugins-dir) sample-database-filename)) |
(defn- process-sample-db-path
[base-path]
(-> base-path
(str/replace #"\.mv\.db$" ) ; strip the .mv.db suffix from the path
codec/url-decode ; for some reason the path can get URL-encoded so we decode it here
(str ";USER=GUEST;PASSWORD=guest"))) ; specify the GUEST user account created for the DB | |
(defn- jar-db-details
[^URL resource]
(-> (.getPath resource)
(str/replace #"^file:" "zip:") ; to connect to an H2 DB inside a JAR just replace file: with zip: (this doesn't
; do anything when running from the Clojure CLI, which has no `file:` prefix)
process-sample-db-path)) | |
(defn- extract-sample-database!
[]
(u.files/with-open-path-to-resource [sample-db-path sample-database-filename]
(let [dest-path (target-path)]
(u.files/copy-file! sample-db-path dest-path)
(-> (str "file:" dest-path)
process-sample-db-path)))) | |
Tries to extract the sample database out of the JAR (for performance) and then returns a db-details map containing a path to the copied database. | (defn- try-to-extract-sample-database!
[]
(let [resource (io/resource sample-database-filename)]
(when-not resource
(throw (Exception. (trs "Sample database DB file ''{0}'' cannot be found."
sample-database-filename))))
{:db
(if-not (:temp (plugins/plugins-dir-info))
(extract-sample-database!)
(do
;; If the plugins directory is a temp directory, fall back to reading the DB directly from the JAR until a
;; working plugins directory is available. (We want to ensure the sample DB is in a stable location.)
(log/warn (trs (str "Sample database could not be extracted to the plugins directory,"
"which may result in slow startup times. "
"Please set MB_PLUGINS_DIR to a writable directory and restart Metabase.")))
(jar-db-details resource)))})) |
Add the sample database as a Metabase DB if it doesn't already exist. | (defn add-sample-database!
[]
(when-not (t2/exists? Database :is_sample true)
(try
(log/info (trs "Loading sample database"))
(let [details (try-to-extract-sample-database!)]
(log/debug "Syncing Sample Database...")
(sync/sync-database! (first (t2/insert-returning-instances! Database
:name sample-database-name
:details details
:engine :h2
:is_sample true))))
(log/debug "Finished adding Sample Database.")
(catch Throwable e
(log/error e (trs "Failed to load sample database")))))) |
Update the path to the sample database DB if it exists in case the JAR has moved. | (defn update-sample-database-if-needed!
([]
(update-sample-database-if-needed! (t2/select-one Database :is_sample true)))
([sample-db]
(when sample-db
(let [intended (try-to-extract-sample-database!)]
(when (not= (:details sample-db) intended)
(t2/update! Database (:id sample-db) {:details intended})))))) |
(ns metabase.search.config (:require [cheshire.core :as json] [clojure.string :as str] [flatland.ordered.map :as ordered-map] [malli.core :as mc] [metabase.models.setting :refer [defsetting]] [metabase.permissions.util :as perms.u] [metabase.public-settings :as public-settings] [metabase.util.i18n :refer [deferred-tru]] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms])) | |
(defsetting search-typeahead-enabled
(deferred-tru "Enable typeahead search in the {0} navbar?"
(public-settings/application-name-for-setting-descriptions))
:type :boolean
:default true
:visibility :authenticated
:export? true
:audit :getter) | |
Number of raw results to fetch from the database. This number is in place to prevent massive application DB load by returning tons of results; this number should probably be adjusted downward once we have UI in place to indicate that results are truncated. Under normal situations it shouldn't be rebound, but it's dynamic to make unit testing easier. | (def ^:dynamic *db-max-results* 1000) |
Number of results to return in an API response | (def ^:const max-filtered-results 1000) |
Results older than this number of days are all considered to be equally old. In other words, there is a ranking
bonus for results newer than this (scaled to just how recent they are). c.f. | (def ^:const stale-time-in-days 180) |
Results in more dashboards than this are all considered to be equally popular. | (def ^:const dashboard-count-ceiling 50) |
Show this many words of context before/after matches in long search results | (def ^:const surrounding-match-context 2) |
Mapping from string model to the Toucan model backing it. | (def model-to-db-model
{"action" {:db-model :model/Action :alias :action}
"card" {:db-model :model/Card :alias :card}
"collection" {:db-model :model/Collection :alias :collection}
"dashboard" {:db-model :model/Dashboard :alias :dashboard}
"database" {:db-model :model/Database :alias :database}
"dataset" {:db-model :model/Card :alias :card}
"indexed-entity" {:db-model :model/ModelIndexValue :alias :model-index-value}
"metric" {:db-model :model/Metric :alias :metric}
"segment" {:db-model :model/Segment :alias :segment}
"table" {:db-model :model/Table :alias :table}}) |
Set of all valid models to search for. | (def all-models (set (keys model-to-db-model))) |
The order of this list influences the order of the results: items earlier in the list will be ranked higher. | (def models-search-order ["dashboard" "metric" "segment" "indexed-entity" "card" "dataset" "collection" "table" "action" "database"]) |
(assert (= all-models (set models-search-order)) "The models search order has to include all models") | |
Return the apporpriate revision model given a search model. | (defn search-model->revision-model
[model]
(case model
"dataset" (recur "card")
(str/capitalize model))) |
Given a model string returns the model alias | (defn model->alias [model] (-> model model-to-db-model :alias)) |
(mu/defn column-with-model-alias :- keyword? "Given a column and a model name, Return a keyword representing the column with the model alias prepended. (column-with-model-alias \"card\" :id) => :card.id)" [model-string :- ms/KeywordOrString column :- ms/KeywordOrString] (keyword (str (name (model->alias model-string)) "." (name column)))) | |
Schema for searchable models | (def SearchableModel (into [:enum] all-models)) |
Map with the various allowed search parameters, used to construct the SQL query. | (def SearchContext
(mc/schema
[:map {:closed true}
[:search-string [:maybe ms/NonBlankString]]
[:archived? :boolean]
[:current-user-perms [:set perms.u/PathSchema]]
[:models [:set SearchableModel]]
[:filter-items-in-personal-collection {:optional true} [:enum "only" "exclude"]]
[:created-at {:optional true} ms/NonBlankString]
[:created-by {:optional true} [:set {:min 1} ms/PositiveInt]]
[:last-edited-at {:optional true} ms/NonBlankString]
[:last-edited-by {:optional true} [:set {:min 1} ms/PositiveInt]]
[:table-db-id {:optional true} ms/PositiveInt]
[:limit-int {:optional true} ms/Int]
[:offset-int {:optional true} ms/Int]
[:search-native-query {:optional true} true?]
;; true to search for verified items only, nil will return all items
[:verified {:optional true} true?]])) |
All columns that will appear in the search results, and the types of those columns. The generated search query is a
SELECT 'card' AS model, id, cast(NULL AS integer) AS table_id, ... FROM report_card UNION ALL SELECT 'metric' as model, id, table_id, ... FROM metric Columns that aren't used in any individual query are replaced with | (def all-search-columns (ordered-map/ordered-map ;; returned for all models. Important to be first for changing model for dataset :model :text :id :integer :name :text :display_name :text :description :text :archived :boolean ;; returned for Card, Dashboard, and Collection :collection_id :integer :collection_name :text :collection_type :text :collection_authority_level :text ;; returned for Card and Dashboard :collection_position :integer :creator_id :integer :created_at :timestamp :bookmark :boolean ;; returned for everything except Collection :updated_at :timestamp ;; returned for Card only, used for scoring and displays :dashboardcard_count :integer :last_edited_at :timestamp :last_editor_id :integer :moderated_status :text :display :text ;; returned for Metric and Segment :table_id :integer :table_schema :text :table_name :text :table_description :text ;; returned for Metric, Segment, and Action :database_id :integer ;; returned for Database and Table :initial_sync_status :text ;; returned for Action :model_id :integer :model_name :text ;; returned for indexed-entity :pk_ref :text :model_index_id :integer ;; returned for Card and Action :dataset_query :text)) |
All of the result components that by default are displayed by the frontend. | (def ^:const displayed-columns
#{:name :display_name :collection_name :description}) |
The columns that will be searched for the query. | (defmulti searchable-columns-for-model
{:arglists '([model])}
(fn [model] model)) |
(defmethod searchable-columns-for-model :default [_] [:name]) | |
(defmethod searchable-columns-for-model "action" [_] [:name :dataset_query :description]) | |
(defmethod searchable-columns-for-model "card" [_] [:name :dataset_query :description]) | |
(defmethod searchable-columns-for-model "dataset" [_] (searchable-columns-for-model "card")) | |
(defmethod searchable-columns-for-model "dashboard" [_] [:name :description]) | |
(defmethod searchable-columns-for-model "page" [_] (searchable-columns-for-model "dashboard")) | |
(defmethod searchable-columns-for-model "database" [_] [:name :description]) | |
(defmethod searchable-columns-for-model "table" [_] [:name :display_name :description]) | |
(defmethod searchable-columns-for-model "indexed-entity" [_] [:name]) | |
Columns returned for all models. | (def ^:private default-columns [:id :name :description :archived :created_at :updated_at]) |
Case statement to return boolean values of | (def ^:private bookmark-col [[:case [:not= :bookmark.id nil] true :else false] :bookmark]) |
Subselect to get the count of associated DashboardCards | (def ^:private dashboardcard-count-col
[{:select [:%count.*]
:from [:report_dashboardcard]
:where [:= :report_dashboardcard.card_id :card.id]}
:dashboardcard_count]) |
Columns containing information about the Table this model references. Returned for Metrics and Segments. | (def ^:private table-columns [:table_id :created_at [:table.db_id :database_id] [:table.schema :table_schema] [:table.name :table_name] [:table.description :table_description]]) |
The columns that will be returned by the query for | (defmulti columns-for-model
{:arglists '([model])}
(fn [model] model)) |
(defmethod columns-for-model "action"
[_]
(conj default-columns :model_id
:creator_id
[:model.collection_id :collection_id]
[:model.id :model_id]
[:model.name :model_name]
[:query_action.database_id :database_id]
[:query_action.dataset_query :dataset_query])) | |
(defmethod columns-for-model "card"
[_]
(conj default-columns :collection_id :collection_position :dataset_query :display :creator_id
[:collection.name :collection_name]
[:collection.authority_level :collection_authority_level]
bookmark-col dashboardcard-count-col)) | |
(defmethod columns-for-model "indexed-entity" [_] [[:model-index-value.name :name] [:model-index-value.model_pk :id] [:model-index.pk_ref :pk_ref] [:model-index.id :model_index_id] [:collection.name :collection_name] [:model.collection_id :collection_id] [:model.id :model_id] [:model.name :model_name] [:model.database_id :database_id]]) | |
(defmethod columns-for-model "dashboard"
[_]
(conj default-columns :collection_id :collection_position :creator_id bookmark-col
[:collection.name :collection_name]
[:collection.authority_level :collection_authority_level])) | |
(defmethod columns-for-model "database" [_] [:id :name :description :created_at :updated_at :initial_sync_status]) | |
(defmethod columns-for-model "collection"
[_]
(conj (remove #{:updated_at} default-columns)
[:collection.id :collection_id]
[:name :collection_name]
[:type :collection_type]
[:authority_level :collection_authority_level]
bookmark-col)) | |
(defmethod columns-for-model "segment" [_] (concat default-columns table-columns [:creator_id])) | |
(defmethod columns-for-model "metric" [_] (concat default-columns table-columns [:creator_id])) | |
(defmethod columns-for-model "table" [_] [:id :name :created_at :display_name :description :updated_at :initial_sync_status [:id :table_id] [:db_id :database_id] [:schema :table_schema] [:name :table_name] [:description :table_description]]) | |
Turn a complex column into a string | (defmulti column->string
(fn [_column-value model column-name]
[(keyword model) column-name])) |
(defmethod column->string :default [value _ _] value) | |
(defmethod column->string [:card :dataset_query]
[value _ _]
(let [query (json/parse-string value true)]
(if (= "native" (:type query))
(-> query :native :query)
""))) | |
Namespace that defines the filters that are applied to the search results. There are required filters and optional filters. Archived is an required filters and is always applied, the reason because by default we want to hide archived/inactive entities. But there are OPTIONAL FILTERS like :created-by, :created-at, when these filters are provided, the results will return only results of models that have these filters. The multi method for optional filters should have the default implementation to throw for unsupported models, and then each model that supports the filter should define its own method for the filter. | (ns metabase.search.filter (:require [clojure.set :as set] [clojure.string :as str] [honey.sql.helpers :as sql.helpers] [metabase.driver.common.parameters.dates :as params.dates] [metabase.models.permissions :as perms] [metabase.public-settings.premium-features :as premium-features] [metabase.search.config :as search.config :refer [SearchableModel SearchContext]] [metabase.search.util :as search.util] [metabase.util.date-2 :as u.date] [metabase.util.i18n :refer [tru]] [metabase.util.malli :as mu]) (:import (java.time LocalDate))) |
(def ^:private true-clause [:inline [:= 1 1]]) (def ^:private false-clause [:inline [:= 0 1]]) | |
------------------------------------------------------------------------------------------------;; Required Filters ; ------------------------------------------------------------------------------------------------;; | |
Clause to filter by the archived status of the entity. | (defmulti ^:private archived-clause
{:arglists '([model archived?])}
(fn [model _] model)) |
(defmethod archived-clause :default [model archived?] [:= (search.config/column-with-model-alias model :archived) archived?]) | |
Databases can't be archived | (defmethod archived-clause "database"
[_model archived?]
(if archived?
false-clause
true-clause)) |
(defmethod archived-clause "indexed-entity"
[_model archived?]
(if-not archived?
true-clause
false-clause)) | |
Table has an | (defmethod archived-clause "table"
[model archived?]
(if archived?
false-clause ; No tables should appear in archive searches
[:and
[:= (search.config/column-with-model-alias model :active) true]
[:= (search.config/column-with-model-alias model :visibility_type) nil]])) |
(mu/defn ^:private search-string-clause-for-model
[model :- SearchableModel
search-context :- SearchContext
search-native-query? :- [:maybe :boolean]]
(when-let [query (:search-string search-context)]
(into
[:or]
(for [column (cond->> (search.config/searchable-columns-for-model model)
(not search-native-query?)
(remove #{:dataset_query})
true
(map #(search.config/column-with-model-alias model %)))
wildcarded-token (->> (search.util/normalize query)
search.util/tokenize
(map search.util/wildcard-match))]
(cond
(and (= model "indexed-entity") (premium-features/sandboxed-or-impersonated-user?))
[:= 0 1]
(and (#{"card" "dataset"} model) (= column (search.config/column-with-model-alias model :dataset_query)))
[:and
[:= (search.config/column-with-model-alias model :query_type) "native"]
[:like [:lower column] wildcarded-token]]
(and (#{"action"} model)
(= column (search.config/column-with-model-alias model :dataset_query)))
[:like [:lower :query_action.dataset_query] wildcarded-token]
:else
[:like [:lower column] wildcarded-token]))))) | |
------------------------------------------------------------------------------------------------;; Optional filters ;; ------------------------------------------------------------------------------------------------;; | |
Build the query to filter by | (defmulti ^:private build-optional-filter-query
{:arglists '([model fitler query filter-value])}
(fn [filter model _query _filter-value]
[filter model])) |
(defmethod build-optional-filter-query :default
[filter model _query _creator-id]
(throw (ex-info (format "%s filter for %s is not supported" filter model) {:filter filter :model model}))) | |
Created by filters | (defn- default-created-by-fitler-clause
[model creator-ids]
(if (= 1 (count creator-ids))
[:= (search.config/column-with-model-alias model :creator_id) (first creator-ids)]
[:in (search.config/column-with-model-alias model :creator_id) creator-ids])) |
(doseq [model ["card" "dataset" "dashboard" "action"]]
(defmethod build-optional-filter-query [:created-by model]
[_filter model query creator-ids]
(sql.helpers/where query (default-created-by-fitler-clause model creator-ids)))) | |
Verified filters | |
(defmethod build-optional-filter-query [:verified "card"]
[_filter model query verified]
(assert (true? verified) "filter for non-verified cards is not supported")
(if (premium-features/has-feature? :content-verification)
(-> query
(sql.helpers/join :moderation_review
[:= :moderation_review.moderated_item_id
(search.config/column-with-model-alias model :id)])
(sql.helpers/where [:= :moderation_review.status "verified"]
[:= :moderation_review.moderated_item_type "card"]
[:= :moderation_review.most_recent true]))
(sql.helpers/where query false-clause))) | |
(defmethod build-optional-filter-query [:verified "dataset"] [filter _model query verified] (build-optional-filter-query filter "card" query verified)) | |
Created at filters | |
(defn- date-range-filter-clause
[dt-col dt-val]
(let [date-range (try
(params.dates/date-string->range dt-val {:inclusive-end? false})
(catch Exception _e
(throw (ex-info (tru "Failed to parse datetime value: {0}" dt-val) {:status-code 400}))))
start (some-> (:start date-range) u.date/parse)
end (some-> (:end date-range) u.date/parse)
dt-col (if (some #(instance? LocalDate %) [start end])
[:cast dt-col :date]
dt-col)]
(cond
(= start end)
[:= dt-col start]
(nil? start)
[:< dt-col end]
(nil? end)
[:> dt-col start]
:else
[:and [:>= dt-col start] [:< dt-col end]]))) | |
(doseq [model ["collection" "database" "table" "dashboard" "card" "dataset" "action"]]
(defmethod build-optional-filter-query [:created-at model]
[_filter model query created-at]
(sql.helpers/where query (date-range-filter-clause
(search.config/column-with-model-alias model :created_at)
created-at)))) | |
Last edited by filter | |
Check if the query have a join with (-> (sql.helpers/select :*) (sql.helpers/from [:a]) (sql.helpers/join :b [:= :a.id :b.id]) (joined-with-table? :join :b)) ;; => true | (defn- joined-with-table? [query join-type table] (->> (get query join-type) (partition 2) (map first) (some #(= % table)) boolean)) |
Return the apporpriate revision model given a search model. | (defn search-model->revision-model
[model]
(case model
"dataset" (recur "card")
(str/capitalize model))) |
(doseq [model ["dashboard" "card" "dataset" "metric"]]
(defmethod build-optional-filter-query [:last-edited-by model]
[_filter model query editor-ids]
(cond-> query
;; both last-edited-by and last-edited-at join with revision, so we should be careful not to join twice
(not (joined-with-table? query :join :revision))
(-> (sql.helpers/join :revision [:= :revision.model_id (search.config/column-with-model-alias model :id)])
(sql.helpers/where [:= :revision.most_recent true]
[:= :revision.model (search.config/search-model->revision-model model)]))
(= 1 (count editor-ids))
(sql.helpers/where [:= :revision.user_id (first editor-ids)])
(> (count editor-ids) 1)
(sql.helpers/where [:in :revision.user_id editor-ids])))) | |
(doseq [model ["dashboard" "card" "dataset" "metric"]]
(defmethod build-optional-filter-query [:last-edited-at model]
[_filter model query last-edited-at]
(cond-> query
;; both last-edited-by and last-edited-at join with revision, so we should be careful not to join twice
(not (joined-with-table? query :join :revision))
(-> (sql.helpers/join :revision [:= :revision.model_id (search.config/column-with-model-alias model :id)])
(sql.helpers/where [:= :revision.most_recent true]
[:= :revision.model (search.config/search-model->revision-model model)]))
true
;; on UI we showed the the last edit info from revision.timestamp
;; not the model.updated_at column
;; to be consistent we use revision.timestamp to do the filtering
(sql.helpers/where (date-range-filter-clause :revision.timestamp last-edited-at))))) | |
TODO: once we record revision for actions, we should update this to use the same approach with dashboard/card | (defmethod build-optional-filter-query [:last-edited-at "action"]
[_filter model query last-edited-at]
(sql.helpers/where query (date-range-filter-clause
(search.config/column-with-model-alias model :updated_at)
last-edited-at))) |
Return A map of filter to its support models. E.g: {:created-by #{"card" "dataset" "dashboard" "action"}} This is function instead of a def so that optional-filter-clause can be defined anywhere in the codebase. | (defn- feature->supported-models
[]
(merge
;; models support search-native-query if dataset_query is one of the searchable columns
{:search-native-query (->> (dissoc (methods search.config/searchable-columns-for-model) :default)
(filter (fn [[k v]]
(contains? (set (v k)) :dataset_query)))
(map first)
set)}
(->> (dissoc (methods build-optional-filter-query) :default)
keys
(reduce (fn [acc [filter model]]
(update acc filter set/union #{model}))
{})))) |
------------------------------------------------------------------------------------------------;; Public functions ;; ------------------------------------------------------------------------------------------------;; | |
(mu/defn search-context->applicable-models :- [:set SearchableModel]
"Returns a set of models that are applicable given the search context.
If the context has optional filters, the models will be restricted for the set of supported models only."
[search-context :- SearchContext]
(let [{:keys [created-at
created-by
last-edited-at
last-edited-by
models
search-native-query
verified]} search-context
feature->supported-models (feature->supported-models)]
(cond-> models
(some? created-at) (set/intersection (:created-at feature->supported-models))
(some? created-by) (set/intersection (:created-by feature->supported-models))
(some? last-edited-at) (set/intersection (:last-edited-at feature->supported-models))
(some? last-edited-by) (set/intersection (:last-edited-by feature->supported-models))
(true? search-native-query) (set/intersection (:search-native-query feature->supported-models))
(true? verified) (set/intersection (:verified feature->supported-models))))) | |
(mu/defn build-filters :- :map
"Build the search filters for a model."
[honeysql-query :- :map
model :- SearchableModel
search-context :- SearchContext]
(let [{:keys [archived?
created-at
created-by
last-edited-at
last-edited-by
search-string
search-native-query
verified]} search-context]
(cond-> honeysql-query
(not (str/blank? search-string))
(sql.helpers/where (search-string-clause-for-model model search-context search-native-query))
(some? archived?)
(sql.helpers/where (archived-clause model archived?))
;; build optional filters
(some? created-at)
(#(build-optional-filter-query :created-at model % created-at))
(some? created-by)
(#(build-optional-filter-query :created-by model % created-by))
(some? last-edited-at)
(#(build-optional-filter-query :last-edited-at model % last-edited-at))
(some? last-edited-by)
(#(build-optional-filter-query :last-edited-by model % last-edited-by))
(some? verified)
(#(build-optional-filter-query :verified model % verified))
(= "table" model)
(sql.helpers/where
[:not [:= (search.config/column-with-model-alias "table" :db_id) perms/audit-db-id]])))) | |
How does search scoring work?This was written for a success engineer, but may be helpful here, too. Most of what you care about happens in the We have two sets of scorers. The first is based on the literal text matches and defined here:
These are all weighted: you can see that the exact-match scorer is responsible for 4/10 of the score, the consecutivity one is 2/10, etc. The second set of scorers is defined lower down, here:
And there are two more for Enterprise here:
These are easier to explain: you get points if the search result is pinned (yes or no), bookmarked (yes or no), how
recently it was updated (sliding value between 1 (edited just now) and 0 (edited 180+
days
ago), how many dashboards it appears in (sliding value between 0 (zero dashboards) and 1 (50+
dashboards)
and it's type (
On the EE side, we also give points if something's an official collection and if it's verified. Finally, what we actually search is defined in the search config here, but the short answer is "the name and, if there is one, the description". We used to search raw SQL queries for cards, but that got turned off recently (but I've seen chat about turning it back on). ❦ So, these 12 scorers are weighted and combined together, and the grand total affects search order. If this sounds a
little complicated…it is! It also means that it can be tricky to give a proper answer about why the search ranking
is "wrong", maybe you search for Also, be aware that as of October 2023 there's a big epic under way to add filtering to search results, which should help people find what they're looking for (and spares us from having to make the above algorithm better). | |
Computes a relevancy score for search results using the weighted average of various scorers. Scores are determined by various ways of comparing the text of the search string and the item's title or description, as well as by Metabase-specific features such as how many dashboards a card appears in or whether an item is pinned. Get the score for a result with Some of the scorers can be tweaked with configuration in [[metabase.search.config]]. | (ns metabase.search.scoring (:require [cheshire.core :as json] [clojure.string :as str] [java-time.api :as t] [metabase.mbql.normalize :as mbql.normalize] [metabase.public-settings.premium-features :refer [defenterprise]] [metabase.search.config :as search.config] [metabase.search.util :as search.util] [metabase.util :as u])) |
(defn- matches? [search-token match-token] (str/includes? match-token search-token)) | |
(defn- matches-in? [search-token match-tokens] (some #(matches? search-token %) match-tokens)) | |
(defn- tokens->string
[tokens abbreviate?]
(let [->string (partial str/join " ")
context search.config/surrounding-match-context]
(if (or (not abbreviate?)
(<= (count tokens) (* 2 context)))
(->string tokens)
(str
(->string (take context tokens))
"…"
(->string (take-last context tokens)))))) | |
Breaks the matched-text into match/no-match chunks and returns a seq of them in order. Each chunk is a map with keys
| (defn- match-context
[query-tokens match-tokens]
(->> match-tokens
(map (fn [match-token]
{:text match-token
:is_match (boolean (some #(matches? % match-token) query-tokens))}))
(partition-by :is_match)
(map (fn [matches-or-misses-maps]
(let [is-match (:is_match (first matches-or-misses-maps))
text-tokens (map :text matches-or-misses-maps)]
{:is_match is-match
:text (tokens->string text-tokens (not is-match))}))))) |
Scores a search result. Returns a vector of score maps, each containing | (defn- text-scores-with
[weighted-scorers query-tokens search-result]
;; TODO is pmap over search-result worth it?
(let [scores (for [column (search.config/searchable-columns-for-model (:model search-result))
{:keys [scorer name weight]
:as _ws} weighted-scorers
:let [matched-text (-> search-result
(get column)
(search.config/column->string (:model search-result) column))
match-tokens (some-> matched-text search.util/normalize search.util/tokenize)
raw-score (scorer query-tokens match-tokens)]
:when (and matched-text (pos? raw-score))]
{:score raw-score
:name (str "text-" name)
:weight weight
:match matched-text
:match-context-thunk #(match-context query-tokens match-tokens)
:column column})]
(if (seq scores)
(vec scores)
[{:score 0 :weight 0}]))) |
(defn- consecutivity-scorer
[query-tokens match-tokens]
(/ (search.util/largest-common-subseq-length
matches?
;; See comment on largest-common-subseq-length re. its cache. This is a little conservative, but better to under- than over-estimate
(take 30 query-tokens)
(take 30 match-tokens))
(count query-tokens))) | |
(defn- occurrences
[query-tokens match-tokens token-matches?]
(reduce (fn [tally token]
(if (token-matches? token match-tokens)
(inc tally)
tally))
0
query-tokens)) | |
How many search tokens show up in the result? | (defn- total-occurrences-scorer
[query-tokens match-tokens]
(/ (occurrences query-tokens match-tokens matches-in?)
(count query-tokens))) |
How many search tokens are exact matches (perfect string match, not | (defn- exact-match-scorer
[query-tokens match-tokens]
(/ (occurrences query-tokens match-tokens #(some (partial = %1) %2))
(count query-tokens))) |
How much of the result is covered by the search query? | (defn fullness-scorer
[query-tokens match-tokens]
(let [match-token-count (count match-tokens)]
(if (zero? match-token-count)
0
(/ (occurrences query-tokens match-tokens matches-in?)
match-token-count)))) |
(defn- prefix-counter
[query-string item-string]
(reduce
(fn [cnt [a b]]
(if (= a b) (inc cnt) (reduced cnt)))
0
(map vector query-string item-string))) | |
Tokens is a seq of strings, like ["abc" "def"] | (defn- count-token-chars [tokens] (reduce (fn [cnt x] (+ cnt (count x))) 0 tokens)) |
How much does the search query match the beginning of the result? | (defn prefix-scorer
[query-tokens match-tokens]
(let [query (u/lower-case-en (str/join " " query-tokens))
match (u/lower-case-en (str/join " " match-tokens))]
(/ (prefix-counter query match)
(count-token-chars query-tokens)))) |
(def ^:private match-based-scorers
[{:scorer exact-match-scorer :name "exact-match" :weight 4}
{:scorer consecutivity-scorer :name "consecutivity" :weight 2}
{:scorer total-occurrences-scorer :name "total-occurrences" :weight 2}
{:scorer fullness-scorer :name "fullness" :weight 1}
{:scorer prefix-scorer :name "prefix" :weight 1}]) | |
(def ^:private model->sort-position (zipmap (reverse search.config/models-search-order) (range))) | |
(defn- model-score
[{:keys [model]}]
(/ (or (model->sort-position model) 0)
(count model->sort-position))) | |
(defn- text-scores-with-match
[raw-search-string result]
(if (seq raw-search-string)
(text-scores-with match-based-scorers
(search.util/tokenize (search.util/normalize raw-search-string))
result)
[{:score 0 :weight 0}])) | |
(defn- pinned-score
[{:keys [model collection_position]}]
;; We experimented with favoring lower collection positions, but it wasn't good
;; So instead, just give a bonus for items that are pinned at all
(if (and (#{"card" "dashboard"} model)
((fnil pos? 0) collection_position))
1
0)) | |
(defn- bookmarked-score
[{:keys [model bookmark]}]
(if (and (#{"card" "collection" "dashboard"} model)
bookmark)
1
0)) | |
(defn- dashboard-count-score
[{:keys [model dashboardcard_count]}]
(if (= model "card")
(min (/ dashboardcard_count
search.config/dashboard-count-ceiling)
1)
0)) | |
(defn- recency-score
[{:keys [updated_at]}]
(let [stale-time search.config/stale-time-in-days
days-ago (if updated_at
(t/time-between updated_at
(t/offset-date-time)
:days)
stale-time)]
(/
(max (- stale-time days-ago) 0)
stale-time))) | |
Massage the raw result from the DB and match data into something more useful for the client | (defn- serialize
[result all-scores relevant-scores]
(let [{:keys [name display_name collection_id collection_name collection_authority_level collection_type]} result
matching-columns (into #{} (remove nil? (map :column relevant-scores)))
match-context-thunk (first (keep :match-context-thunk relevant-scores))]
(-> result
(assoc
:name (if (and (contains? matching-columns :display_name) display_name)
display_name
name)
:context (when (and match-context-thunk
(empty?
(remove matching-columns search.config/displayed-columns)))
(match-context-thunk))
:collection {:id collection_id
:name collection_name
:authority_level collection_authority_level
:type collection_type}
:scores all-scores)
(update :dataset_query #(some-> % json/parse-string mbql.normalize/normalize))
(dissoc
:collection_id
:collection_name
:collection_type
:display_name)))) |
Default weights and scores for a given result. | (defn weights-and-scores
[result]
[{:weight 2 :score (pinned-score result) :name "pinned"}
{:weight 2 :score (bookmarked-score result) :name "bookmarked"}
{:weight 3/2 :score (recency-score result) :name "recency"}
{:weight 1 :score (dashboard-count-score result) :name "dashboard"}
{:weight 1/2 :score (model-score result) :name "model"}]) |
Score a result, returning a collection of maps with score and weight. Should not include the text scoring, done separately. Should return a sequence of maps with {:weight number, :score number, :name string} | (defenterprise score-result metabase-enterprise.search.scoring [result] (weights-and-scores result)) |
(defn- sum-weights [weights]
(reduce
(fn [acc {:keys [weight] :or {weight 0}}]
(+ acc weight))
0
weights)) | |
(defn- compute-normalized-score [scores]
(let [weight-sum (sum-weights scores)]
(if (zero? weight-sum)
0
(let [score-sum (reduce
(fn [acc {:keys [weight score]
:or {weight 0 score 0}}]
(+ acc (* score weight)))
0
scores)]
(/ score-sum weight-sum))))) | |
Reweight | (defn force-weight
[scores total]
(let [total-weight (sum-weights scores)
weight-calc-fn (if (contains? #{nil 0} total-weight)
(fn weight-calc-fn [_] 0)
(fn weight-calc-fn [weight] (* total (/ weight total-weight))))]
(mapv #(update % :weight weight-calc-fn) scores))) |
This is used to control the total weight of text-based scorers in [[score-and-result]] | (def ^:const text-scores-weight 10) |
Returns a map with the normalized, combined score from relevant-scores as | (defn score-and-result
[raw-search-string result]
(let [text-matches (-> raw-search-string
(text-scores-with-match result)
(force-weight text-scores-weight))
all-scores (into (vec (score-result result)) text-matches)
relevant-scores (remove #(= 0 (:score %)) all-scores)
total-score (compute-normalized-score all-scores)]
;; Searches with a blank search string mean "show me everything, ranked";
;; see https://github.com/metabase/metabase/pull/15604 for archived search.
;; If the search string is non-blank, results with no text match have a score of zero.
(if (or (str/blank? raw-search-string)
(pos? (reduce (fn [acc {:keys [score] :or {score 0}}] (+ acc score))
0
text-matches)))
{:score total-score
:result (serialize result all-scores relevant-scores)}
{:score 0}))) |
Compare maps of scores and results. Must return -1, 0, or 1. The score is assumed to be a vector, and will be compared in order. | (defn compare-score
[{score-1 :score} {score-2 :score}]
(compare score-1 score-2)) |
Given a reducible collection (i.e., from | (defn top-results
[reducible-results max-results xf]
(->> reducible-results
(transduce xf (u/sorted-take max-results compare-score))
rseq
(map :result))) |
(ns metabase.search.util (:require [clojure.core.memoize :as memoize] [clojure.string :as str] [metabase.util :as u] [metabase.util.malli :as mu])) | |
Returns a string pattern to match a wildcard search term. | (defn wildcard-match [s] (str "%" s "%")) |
(mu/defn normalize :- :string "Normalize a `query` to lower-case." [query :- :string] (u/lower-case-en (str/trim query))) | |
(mu/defn tokenize :- [:sequential :string]
"Break a search `query` into its constituent tokens"
[query :- :string]
(filter seq
(str/split query #"\s+"))) | |
Given two lists (and an equality test), return the length of the longest overlapping subsequence. (largest-common-subseq-length = [1 2 3 :this :part :will :not :be :relevant] [:not :counted 1 2 3 :also :not :counted]) ;; => 3 | (def largest-common-subseq-length
(memoize/fifo
(fn
([eq xs ys]
(largest-common-subseq-length eq xs ys 0))
([eq xs ys tally]
(if (or (zero? (count xs))
(zero? (count ys)))
tally
(max
(if (eq (first xs)
(first ys))
(largest-common-subseq-length eq (rest xs) (rest ys) (inc tally))
tally)
(largest-common-subseq-length eq xs (rest ys) 0)
(largest-common-subseq-length eq (rest xs) ys 0)))))
;; Uses O(n*m) space (the lengths of the two lists) with k≤2, so napkin math suggests this gives us caching for at
;; least a 31*31 search (or 50*20, etc) which sounds like more than enough. Memory is cheap and the items are
;; small, so we may as well skew high.
;; As a precaution, the scorer that uses this limits the number of tokens (see the `take` call below)
:fifo/threshold 2000)) |
Code related to configuring, starting, and stopping the Metabase Jetty web server. | (ns metabase.server (:require [clojure.core :as core] [clojure.string :as str] [medley.core :as m] [metabase.config :as config] [metabase.server.protocols :as server.protocols] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [ring.adapter.jetty9 :as ring-jetty] [ring.adapter.jetty9.servlet :as servlet]) (:import (jakarta.servlet AsyncContext) (jakarta.servlet.http HttpServletRequest HttpServletResponse) (org.eclipse.jetty.server Request Server) (org.eclipse.jetty.server.handler AbstractHandler StatisticsHandler))) |
(set! *warn-on-reflection* true) | |
(defn- jetty-ssl-config []
(m/filter-vals
some?
{:ssl-port (config/config-int :mb-jetty-ssl-port)
:keystore (config/config-str :mb-jetty-ssl-keystore)
:key-password (config/config-str :mb-jetty-ssl-keystore-password)
:truststore (config/config-str :mb-jetty-ssl-truststore)
:trust-password (config/config-str :mb-jetty-ssl-truststore-password)
:client-auth (when (config/config-bool :mb-jetty-ssl-client-auth)
:need)
:sni-host-check? (when (config/config-str :mb-jetty-skip-sni)
false)})) | |
(defn- jetty-config []
(cond-> (m/filter-vals
some?
{:port (config/config-int :mb-jetty-port)
:host (config/config-str :mb-jetty-host)
:max-threads (config/config-int :mb-jetty-maxthreads)
:min-threads (config/config-int :mb-jetty-minthreads)
:max-queued (config/config-int :mb-jetty-maxqueued)
:max-idle-time (config/config-int :mb-jetty-maxidletime)})
(config/config-int :mb-jetty-request-header-size) (assoc :request-header-size (config/config-int
:mb-jetty-request-header-size))
(config/config-str :mb-jetty-daemon) (assoc :daemon? (config/config-bool :mb-jetty-daemon))
(config/config-str :mb-jetty-ssl) (-> (assoc :ssl? true)
(merge (jetty-ssl-config))))) | |
(defn- log-config [jetty-config]
(log/info "Launching Embedded Jetty Webserver with config:\n"
(u/pprint-to-str (m/filter-keys
#(not (str/includes? % "password"))
jetty-config)))) | |
(defonce ^:private instance* (atom nil)) | |
THE instance of our Jetty web server, if there currently is one. | (defn instance ^Server [] @instance*) |
(defn- async-proxy-handler ^AbstractHandler [handler timeout]
(proxy [AbstractHandler] []
(handle [_ ^Request base-request ^HttpServletRequest request ^HttpServletResponse response]
(let [^AsyncContext context (doto (.startAsync request)
(.setTimeout timeout))
request-map (servlet/build-request-map request)
raise (fn raise [^Throwable e]
(log/error e (trs "Unexpected exception in endpoint"))
(try
(.sendError response 500 (.getMessage e))
(catch Throwable e
(log/error e (trs "Unexpected exception writing error response"))))
(.complete context))]
(try
(handler
request-map
(fn [response-map]
(server.protocols/respond (:body response-map) {:request request
:request-map request-map
:async-context context
:response response
:response-map response-map}))
raise)
(catch Throwable e
(log/error e (trs "Unexpected Exception in API request handler"))
(raise e))
(finally
(.setHandled base-request true))))))) | |
Create a new async Jetty server with | (defn create-server
^Server [handler options]
;; if any API endpoint functions aren't at the very least returning a channel to fetch the results later after 10
;; minutes we're in serious trouble. (Almost everything 'slow' should be returning a channel before then, but
;; some things like CSV downloads don't currently return channels at this time)
;;
;; TODO - I suppose the default value should be moved to the `metabase.config` namespace?
(let [timeout (or (config/config-int :mb-jetty-async-response-timeout)
(* 10 60 1000))
handler (async-proxy-handler handler timeout)
stats-handler (doto (StatisticsHandler.)
(.setHandler handler))]
(doto ^Server (#'ring-jetty/create-server (assoc options :async? true))
(.setHandler stats-handler)))) |
Start the embedded Jetty web server. Returns (start-web-server! #'metabase.server.handler/app) | (defn start-web-server!
[handler]
(when-not (instance)
;; NOTE: we always start jetty w/ join=false so we can start the server first then do init in the background
(let [config (jetty-config)
new-server (create-server handler config)]
(log-config config)
;; Only start the server if the newly created server becomes the official new server
;; Don't JOIN yet -- we're doing other init in the background; we can join later
(when (compare-and-set! instance* nil new-server)
(.start new-server)
:started)))) |
Stop the embedded Jetty web server. Returns | (defn stop-web-server!
[]
(let [[^Server old-server] (reset-vals! instance* nil)]
(when old-server
(log/info (trs "Shutting Down Embedded Jetty Webserver"))
(.stop old-server)
:stopped))) |
Top-level Metabase Ring handler. | (ns metabase.server.handler (:require [metabase.config :as config] [metabase.server.middleware.auth :as mw.auth] [metabase.server.middleware.browser-cookie :as mw.browser-cookie] [metabase.server.middleware.exceptions :as mw.exceptions] [metabase.server.middleware.json :as mw.json] [metabase.server.middleware.log :as mw.log] [metabase.server.middleware.misc :as mw.misc] [metabase.server.middleware.offset-paging :as mw.offset-paging] [metabase.server.middleware.security :as mw.security] [metabase.server.middleware.session :as mw.session] [metabase.server.middleware.ssl :as mw.ssl] [metabase.server.routes :as routes] [metabase.util.log :as log] [ring.core.protocols :as ring.protocols] [ring.middleware.cookies :refer [wrap-cookies]] [ring.middleware.gzip :refer [wrap-gzip]] [ring.middleware.keyword-params :refer [wrap-keyword-params]] [ring.middleware.params :refer [wrap-params]])) |
(extend-protocol ring.protocols/StreamableResponseBody
;; java.lang.Double, java.lang.Long, and java.lang.Boolean will be given a Content-Type of "application/json; charset=utf-8"
;; so they should be strings, and will be parsed into their respective values.
java.lang.Number
(write-body-to-stream [num response output-stream]
(ring.protocols/write-body-to-stream (str num) response output-stream))
java.lang.Boolean
(write-body-to-stream [bool response output-stream]
(ring.protocols/write-body-to-stream (str bool) response output-stream))
clojure.lang.Keyword
(write-body-to-stream [kkey response output-stream]
(ring.protocols/write-body-to-stream
(if-let [key-ns (namespace kkey)]
(str key-ns "/" (name kkey))
(name kkey))
response output-stream))) | |
(def ^:private middleware ;; ▼▼▼ POST-PROCESSING ▼▼▼ happens from TOP-TO-BOTTOM [#'mw.exceptions/catch-uncaught-exceptions ; catch any Exceptions that weren't passed to `raise` #'mw.exceptions/catch-api-exceptions ; catch exceptions and return them in our expected format #'mw.log/log-api-call #'mw.browser-cookie/ensure-browser-id-cookie ; add cookie to identify browser; add `:browser-id` to the request #'mw.security/add-security-headers ; Add HTTP headers to API responses to prevent them from being cached #'mw.json/wrap-json-body ; extracts json POST body and makes it avaliable on request #'mw.offset-paging/handle-paging ; binds per-request parameters to handle paging #'mw.json/wrap-streamed-json-response ; middleware to automatically serialize suitable objects as JSON in responses #'wrap-keyword-params ; converts string keys in :params to keyword keys #'wrap-params ; parses GET and POST params as :query-params/:form-params and both as :params #'mw.misc/maybe-set-site-url ; set the value of `site-url` if it hasn't been set yet #'mw.session/reset-session-timeout ; Resets the timeout cookie for user activity to [[mw.session/session-timeout]] #'mw.session/bind-current-user ; Binds *current-user* and *current-user-id* if :metabase-user-id is non-nil #'mw.session/wrap-current-user-info ; looks for :metabase-session-id and sets :metabase-user-id and other info if Session ID is valid #'mw.session/wrap-session-id ; looks for a Metabase Session ID and assoc as :metabase-session-id #'mw.auth/wrap-static-api-key ; looks for a static Metabase API Key on the request and assocs as :metabase-api-key #'wrap-cookies ; Parses cookies in the request map and assocs as :cookies #'mw.misc/add-content-type ; Adds a Content-Type header for any response that doesn't already have one #'mw.misc/disable-streaming-buffering ; Add header to streaming (async) responses so ngnix doesn't buffer keepalive bytes #'wrap-gzip ; GZIP response if client can handle it #'mw.misc/bind-request ; bind `metabase.middleware.misc/*request*` for the duration of the request #'mw.ssl/redirect-to-https-middleware]) | |
▲▲▲ PRE-PROCESSING ▲▲▲ happens from BOTTOM-TO-TOP | |
(defn- apply-middleware
[handler]
(reduce
(fn [handler middleware-fn]
(middleware-fn handler))
handler
middleware)) | |
The primary entry point to the Ring HTTP server. | (def app (apply-middleware routes/routes)) |
during interactive dev, recreate | (when config/is-dev?
(doseq [varr (cons #'routes/routes middleware)
:when (instance? clojure.lang.IRef varr)]
(add-watch varr ::reload (fn [_ _ _ _]
(log/infof "%s changed, rebuilding %s" varr #'app)
(alter-var-root #'app (constantly (apply-middleware routes/routes))))))) |
Middleware related to enforcing authentication/API keys (when applicable). Unlike most other middleware most of this
is not used as part of the normal | (ns metabase.server.middleware.auth (:require [clojure.string :as str] [metabase.models.setting :refer [defsetting]] [metabase.server.middleware.util :as mw.util] [metabase.util.i18n :refer [deferred-trs]])) |
(def ^:private ^:const ^String static-metabase-api-key-header "x-metabase-apikey") | |
Middleware that returns a 401 response if | (defn enforce-authentication
[handler]
(fn [{:keys [metabase-user-id] :as request} respond raise]
(if metabase-user-id
(handler request respond raise)
(respond mw.util/response-unauthentic)))) |
(defn- wrap-static-api-key* [{:keys [headers], :as request}]
(if-let [api-key (headers static-metabase-api-key-header)]
(assoc request :static-metabase-api-key api-key)
request)) | |
Middleware that sets the | (defn wrap-static-api-key
[handler]
(fn [request respond raise]
(handler (wrap-static-api-key* request) respond raise))) |
When set, this API key is required for all API requests. | (defsetting api-key :visibility :internal) |
We don't want to change the name of the setting from | (defn static-api-key [] (api-key)) |
Url for documentation on how to set MBAPIKEY. | (def mb-api-key-doc-url "https://www.metabase.com/docs/latest/configuring-metabase/environment-variables#mb_api_key") |
Response when the MBAPIKEY is not set. | (def key-not-set-response
{:status 403
:body (deferred-trs "MB_API_KEY is not set. See {0} for details" mb-api-key-doc-url)}) |
Middleware that enforces validation of the client via API Key, canceling the request processing if the check fails. Validation is handled by first checking for the presence of the If the request This variable only works for /api/notify/db/:id endpoint | (defn enforce-static-api-key
[handler]
(fn [{:keys [static-metabase-api-key], :as request} respond raise]
(cond (str/blank? (static-api-key))
(respond key-not-set-response)
(not static-metabase-api-key)
(respond mw.util/response-forbidden)
(= (static-api-key) static-metabase-api-key)
(handler request respond raise)
:else
(respond mw.util/response-forbidden)))) |
Middleware that sets a permanent browser identifier cookie so we can identify logins from new browsers. This is mostly so we can send people 'login from a new device' emails the first time they log in with a new browser. If this cookie is deleted, it's fine; the user will just get an email saying they logged in from a new device next time they log in. | (ns metabase.server.middleware.browser-cookie (:require [java-time.api :as t] [metabase.server.request.util :as request.u] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [ring.util.response :as response])) |
(set! *warn-on-reflection* true) | |
(def ^:private browser-id-cookie-name "metabase.DEVICE") | |
This cookie doesn't need to be secure, because it's only used for notification purposes and cannot be used for CSRF as it is not a session cookie. However, we do need to make sure it's persisted/sent as much as possible to prevent superfluous login notification emails when used with full-app embedding, which means setting SameSite=None when possible (over HTTPS) and SameSite=Lax otherwise. (See #18553) | (defn- cookie-options
[request]
(merge {:http-only true
:path "/"
;; Set the cookie to expire 20 years from now. That should be sufficient
:expires (t/format :rfc-1123-date-time (t/plus (t/zoned-date-time) (t/years 20)))}
(if (request.u/https? request)
{:same-site :none, :secure true}
{:same-site :lax}))) |
(mu/defn ^:private add-browser-id-cookie [request response browser-id :- ms/NonBlankString] (response/set-cookie response browser-id-cookie-name browser-id (cookie-options request))) | |
Set a permanent browser identifier cookie if one is not already set. | (defn ensure-browser-id-cookie
[handler]
(fn [request respond raise]
(if-let [browser-id (get-in request [:cookies browser-id-cookie-name :value])]
(handler (assoc request :browser-id browser-id) respond raise)
(let [browser-id (str (random-uuid))]
(handler
(assoc request :browser-id browser-id)
(fn [response]
(respond (add-browser-id-cookie request response browser-id)))
raise))))) |
Ring middleware for handling Exceptions thrown in API request handler functions. | (ns metabase.server.middleware.exceptions (:require [clojure.java.jdbc :as jdbc] [clojure.string :as str] [metabase.server.middleware.security :as mw.security] [metabase.util.i18n :refer [deferred-tru trs]] [metabase.util.log :as log]) (:import (java.sql SQLException) (org.eclipse.jetty.io EofException))) |
(set! *warn-on-reflection* true) | |
(declare api-exception-response) | |
Catch any exceptions other than 404 thrown in the request handler body and rethrow a generic 400 exception instead. This minimizes information available to bad actors when exceptions occur on public endpoints. | (defn public-exceptions
[handler]
(fn [request respond _]
(let [raise (fn [e]
(log/warn e (trs "Exception in API call"))
(if (= 404 (:status-code (ex-data e)))
(respond {:status 404, :body (deferred-tru "Not found.")})
(respond {:status 400, :body (deferred-tru "An error occurred.")})))]
(try
(handler request respond raise)
(catch Throwable e
(raise e)))))) |
Catch any exceptions thrown in the request handler body and rethrow a 400 exception that only has the message from the original instead (i.e., don't rethrow the original stacktrace). This reduces the information available to bad actors but still provides some information that will prove useful in debugging errors. | (defn message-only-exceptions
[handler]
(fn [request respond _]
(let [raise (fn [^Throwable e]
(respond {:status 400, :body (.getMessage e)}))]
(try
(handler request respond raise)
(catch Throwable e
(log/error e (trs "Exception in API call"))
(raise e)))))) |
Convert an uncaught exception from an API endpoint into an appropriate format to be returned by the REST API (e.g. a map, which eventually gets serialized to JSON, or a plain string message). | (defmulti api-exception-response
{:arglists '([e])}
class) |
(defmethod api-exception-response Throwable
[^Throwable e]
(let [{:keys [status-code], :as info} (ex-data e)
other-info (dissoc info :status-code :schema :type :toucan2/context-trace)
body (cond
(and status-code (not= status-code 500) (empty? other-info))
;; If status code was specified (but not a 500 -- an unexpected error, and
;; other data wasn't, it's something like a 404. Return message as
;; the (plain-text) body.
(.getMessage e)
;; if the response includes `:errors`, (e.g., it's something like a generic
;; parameter validation exception), just return the `other-info` from the
;; ex-data.
(and status-code (:errors other-info))
other-info
;; Otherwise return the full `Throwable->map` representation with Stacktrace
;; and ex-data
:else
(merge
(Throwable->map e)
{:message (.getMessage e)}
other-info))]
{:status (or status-code 500)
:headers (mw.security/security-headers)
:body body})) | |
(defmethod api-exception-response SQLException
[e]
(-> ((get-method api-exception-response (.getSuperclass SQLException)) e)
(assoc-in [:body :sql-exception-chain] (str/split (with-out-str (jdbc/print-sql-exception-chain e))
#"\s*\n\s*")))) | |
(defmethod api-exception-response EofException
[_e]
(log/info (trs "Request canceled before finishing."))
{:status-code 204, :body nil, :headers (mw.security/security-headers)}) | |
Middleware (with | (defn catch-api-exceptions
[handler]
(fn [request respond _raise]
(handler
request
respond
(comp respond api-exception-response)))) |
Middleware (with | (defn catch-uncaught-exceptions
[handler]
(fn [request respond raise]
(try
(handler
request
;; for people that accidentally pass along an Exception, e.g. from qp.async, do the nice thing and route it to
;; the right place for them
(fn [response]
((if (instance? Throwable response)
raise
respond) response))
raise)
(catch Throwable e
(raise e))))) |
Middleware related to parsing JSON requests and generating JSON responses. | (ns metabase.server.middleware.json (:require [cheshire.core :as json] [cheshire.factory] [cheshire.generate :as json.generate] [metabase.util.date-2 :as u.date] [ring.middleware.json :as ring.json] [ring.util.io :as rui] [ring.util.response :as response]) (:import (com.fasterxml.jackson.core JsonGenerator) (java.io BufferedWriter OutputStream OutputStreamWriter) (java.nio.charset StandardCharsets) (java.time.temporal Temporal))) |
(set! *warn-on-reflection* true) | |
+----------------------------------------------------------------------------------------------------------------+ | JSON SERIALIZATION CONFIG | +----------------------------------------------------------------------------------------------------------------+ | |
Tell the JSON middleware to use a date format that includes milliseconds (why?) | (def ^:private default-date-format "yyyy-MM-dd'T'HH:mm:ss.SSS'Z'") |
(alter-var-root #'cheshire.factory/default-date-format (constantly default-date-format)) (alter-var-root #'json.generate/*date-format* (constantly default-date-format)) | |
Custom JSON encoders | |
(defn- write-string! [^JsonGenerator json-generator, ^String s] (.writeString json-generator s)) | |
For java.time classes use the date util function that writes them as ISO-8601 | (json.generate/add-encoder Temporal (fn [t json-generator]
(write-string! json-generator (u.date/format t)))) |
Always fall back to | (json.generate/add-encoder Object json.generate/encode-str) |
Binary arrays ("[B") -- hex-encode their first four bytes, e.g. "0xC42360D7" | (json.generate/add-encoder
(Class/forName "[B")
(fn [byte-ar json-generator]
(write-string! json-generator (apply str "0x" (for [b (take 4 byte-ar)]
(format "%02X" b)))))) |
+----------------------------------------------------------------------------------------------------------------+ | Parsing JSON Requests | +----------------------------------------------------------------------------------------------------------------+ | |
Middleware that parses JSON in the body of a request. (This is basically a copy of | (defn wrap-json-body
;; TODO - we should really just fork ring-json-middleware and put these changes in the fork, or submit this as a PR
[handler]
(fn
[request respond raise]
(if-let [[valid? json] (#'ring.json/read-json request {:keywords? true})]
(if valid?
(handler (assoc request :body json) respond raise)
(respond ring.json/default-malformed-response))
(handler request respond raise)))) |
+----------------------------------------------------------------------------------------------------------------+ | Streaming JSON Responses | +----------------------------------------------------------------------------------------------------------------+ | |
Write | (defn- streamed-json-response
[response-seq opts]
(rui/piped-input-stream
(fn [^OutputStream output-stream]
(with-open [output-writer (OutputStreamWriter. output-stream StandardCharsets/UTF_8)
buffered-writer (BufferedWriter. output-writer)]
(json/generate-stream response-seq buffered-writer opts))))) |
(defn- wrap-streamed-json-response* [opts response]
(if-let [json-response (and (coll? (:body response))
(update response :body streamed-json-response opts))]
(if (contains? (:headers json-response) "Content-Type")
json-response
(response/content-type json-response "application/json; charset=utf-8"))
response)) | |
Similar to ring.middleware/wrap-json-response in that it will serialize the response's body to JSON if it's a collection. Rather than generating a string it will stream the response using a PipedOutputStream. Accepts the following options (same as :pretty - true if the JSON should be pretty-printed :escape-non-ascii - true if non-ASCII characters should be escaped with \u | (defn wrap-streamed-json-response
"Similar to ring.middleware/wrap-json-response in that it will serialize the response's body to JSON if it's a
collection. Rather than generating a string it will stream the response using a PipedOutputStream.
Accepts the following options (same as `wrap-json-response`):
:pretty - true if the JSON should be pretty-printed
:escape-non-ascii - true if non-ASCII characters should be escaped with \\u"
[handler & [{:as opts}]]
(fn [request respond raise]
(handler
request
(comp respond (partial wrap-streamed-json-response* opts))
raise))) |
Ring middleware for logging API requests/responses. | (ns metabase.server.middleware.log
(:require
[clojure.core.async :as a]
[clojure.string :as str]
[metabase.async.streaming-response :as streaming-response]
[metabase.async.streaming-response.thread-pool :as thread-pool]
[metabase.async.util :as async.u]
[metabase.db.connection :as mdb.connection]
[metabase.driver.sql-jdbc.execute.diagnostic
:as sql-jdbc.execute.diagnostic]
[metabase.server :as server]
[metabase.server.request.util :as request.u]
[metabase.util :as u]
[metabase.util.i18n :refer [trs]]
[metabase.util.log :as log]
[toucan2.core :as t2])
(:import
(clojure.core.async.impl.channels ManyToManyChannel)
(com.mchange.v2.c3p0 PoolBackedDataSource)
(metabase.async.streaming_response StreamingResponse)
(org.eclipse.jetty.util.thread QueuedThreadPool))) |
(set! *warn-on-reflection* true) | |
To simplify passing large amounts of arguments around most functions in this namespace take an "info" map that looks like
This map is created in | |
+----------------------------------------------------------------------------------------------------------------+ | Getting & Formatting Request/Response Info | +----------------------------------------------------------------------------------------------------------------+ | |
These functions take parts of the info map and convert it into formatted strings. | |
(defn- format-status-info
[{:keys [async-status]
{:keys [request-method uri] :or {request-method :XXX}} :request
{:keys [status]} :response}]
(str
(format "%s %s %d" (u/upper-case-en (name request-method)) uri status)
(when async-status
(format " [%s: %s]" (trs "ASYNC") async-status)))) | |
(defn- format-performance-info
[{:keys [start-time call-count-fn _diag-info-fn]
:or {start-time (System/nanoTime)
call-count-fn (constantly -1)}}]
(let [elapsed-time (u/format-nanoseconds (- (System/nanoTime) start-time))
db-calls (call-count-fn)]
(trs "{0} ({1} DB calls)" elapsed-time db-calls))) | |
(defn- stats [diag-info-fn]
(str
(when-let [^PoolBackedDataSource pool (let [data-source (mdb.connection/data-source)]
(when (instance? PoolBackedDataSource data-source)
data-source))]
(trs "App DB connections: {0}/{1}"
(.getNumBusyConnectionsAllUsers pool) (.getNumConnectionsAllUsers pool)))
" "
(when-let [^QueuedThreadPool pool (some-> (server/instance) .getThreadPool)]
(trs "Jetty threads: {0}/{1} ({2} idle, {3} queued)"
(.getBusyThreads pool)
(.getMaxThreads pool)
(.getIdleThreads pool)
(.getQueueSize pool)))
" "
(trs "({0} total active threads)" (Thread/activeCount))
" "
(trs "Queries in flight: {0}" (thread-pool/active-thread-count))
" "
(trs "({0} queued)" (thread-pool/queued-thread-count))
(when diag-info-fn
(when-let [diag-info (not-empty (diag-info-fn))]
(format
"; %s DB %s connections: %d/%d (%d threads blocked)"
(some-> diag-info ::sql-jdbc.execute.diagnostic/driver name)
(::sql-jdbc.execute.diagnostic/database-id diag-info)
(::sql-jdbc.execute.diagnostic/active-connections diag-info)
(::sql-jdbc.execute.diagnostic/total-connections diag-info)
(::sql-jdbc.execute.diagnostic/threads-waiting diag-info)))))) | |
(defn- format-threads-info [{:keys [diag-info-fn]} {:keys [include-stats?]}]
(when include-stats?
(stats diag-info-fn))) | |
(defn- format-error-info [{{:keys [body]} :response} {:keys [error?]}]
(when (and error?
(or (string? body) (coll? body)))
(str "\n" (u/pprint-to-str body)))) | |
(defn- format-info [info opts]
(str/join " " (filter some? [(format-status-info info)
(format-performance-info info)
(format-threads-info info opts)
(format-error-info info opts)]))) | |
+----------------------------------------------------------------------------------------------------------------+ | Logging the Info | +----------------------------------------------------------------------------------------------------------------+ | |
| |
| (def ^:private log-options
[{:status-pred #(>= % 500)
:error? true
:color 'red
:log-fn #(log/error %)
:include-stats? false}
{:status-pred #(>= % 403)
:error? true
:color 'red
:log-fn #(log/warn %)
:include-stats? false}
{:status-pred #(>= % 400)
:error? true
:color 'red
:log-fn #(log/debug %)
:include-stats? false}
{:status-pred (constantly true)
:error? false
:color 'green
:log-fn #(log/debug %)
:include-stats? true}]) |
(defn- log-info
[{{:keys [status] :or {status -1}} :response, :as info}]
(try
(let [{:keys [color log-fn]
:or {color :default-color
log-fn identity}
:as opts}
(some #(when ((:status-pred %) status) %)
log-options)]
(log-fn (u/format-color color (format-info info opts))))
(catch Throwable e
(log/error e (trs "Error logging API request"))))) | |
+----------------------------------------------------------------------------------------------------------------+ | Async Logging | +----------------------------------------------------------------------------------------------------------------+ | |
These functions call | |
For async responses that return a | (defn- log-core-async-response
[{{chan :body, :as _response} :response, :as info}]
{:pre [(async.u/promise-chan? chan)]}
;; [async] wait for the pipe to close the canceled/finished channel and log the API response
(a/go
(let [result (a/<! chan)]
(log-info (assoc info :async-status (if (nil? result) "canceled" "completed")))))) |
(defn- log-streaming-response [{{streaming-response :body, :as _response} :response, :as info}]
;; [async] wait for the streaming response to be canceled/finished channel and log the API response
(let [finished-chan (streaming-response/finished-chan streaming-response)]
(a/go
(let [result (a/<! finished-chan)]
(log-info (assoc info :async-status (name result))))))) | |
Log an API response. Returns resonse, possibly modified (i.e., core.async channels will be wrapped); this value
should be passed to the normal | (defn- logged-response
[{{:keys [body], :as response} :response, :as info}]
(condp instance? body
ManyToManyChannel (log-core-async-response info)
StreamingResponse (log-streaming-response info)
(log-info info))
response) |
+----------------------------------------------------------------------------------------------------------------+ | Middleware | +----------------------------------------------------------------------------------------------------------------+ | |
Actual middleware. Determines whether request should be logged, and, if so, creates the info dictionary and hands off to functions above. | |
(defn- should-log-request? [{:keys [uri], :as request}]
;; don't log calls to /health or /util/logs because they clutter up the logs (especially the window in admin) with
;; useless lines
(and (request.u/api-call? request)
(not (#{"/api/util/logs"} uri)))) | |
Logs info about request such as status code, number of DB calls, and time taken to complete. | (defn log-api-call
[handler]
(fn [request respond raise]
(if-not (should-log-request? request)
;; non-API call or health or logs call, don't log it
(handler request respond raise)
;; API call, log info about it
(t2/with-call-count [call-count-fn]
(sql-jdbc.execute.diagnostic/capturing-diagnostic-info [diag-info-fn]
(let [info {:request request
:start-time (System/nanoTime)
:call-count-fn call-count-fn
:diag-info-fn diag-info-fn}
response->info (fn [response]
(assoc info :response response))
respond (comp respond logged-response response->info)]
(handler request respond raise))))))) |
Misc Ring middleware. | (ns metabase.server.middleware.misc (:require [clojure.string :as str] [metabase.async.streaming-response] [metabase.db :as mdb] [metabase.public-settings :as public-settings] [metabase.server.request.util :as request.u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log]) (:import (clojure.core.async.impl.channels ManyToManyChannel) (metabase.async.streaming_response StreamingResponse))) |
(comment metabase.async.streaming-response/keep-me) | |
(defn- add-content-type* [{:keys [body], {:strs [Content-Type]} :headers, :as response}]
(cond-> response
(not Content-Type)
(assoc-in [:headers "Content-Type"] (if (string? body)
"text/plain"
"application/json; charset=utf-8")))) | |
Add an appropriate Content-Type header to response if it doesn't already have one. Most responses should already have one, so this is a fallback for ones that for one reason or another do not. | (defn add-content-type
[handler]
(fn [request respond raise]
(handler request
(if-not (request.u/api-call? request)
respond
(comp respond add-content-type*))
raise))) |
------------------------------------------------ SETTING SITE-URL ------------------------------------------------ | |
It's important for us to know what the site URL is for things like returning links, etc. this is stored in the
Effectively the very first API request that gets sent to us (usually some sort of setup request) ends up setting
the (initial) value of | (defn- maybe-set-site-url* [{{:strs [origin x-forwarded-host host user-agent]} :headers, uri :uri}]
(when (and (mdb/db-is-set-up?)
(not (public-settings/site-url))
(not= uri "/api/health")
(or (nil? user-agent) ((complement str/includes?) user-agent "HealthChecker")))
(when-let [site-url (or origin x-forwarded-host host)]
(log/info (trs "Setting Metabase site URL to {0}" site-url))
(try
(public-settings/site-url! site-url)
(catch Throwable e
(log/warn e (trs "Failed to set site-url"))))))) |
Middleware to set the | (defn maybe-set-site-url
[handler]
(fn [request respond raise]
(maybe-set-site-url* request)
(handler request respond raise))) |
------------------------------------------ Disable Streaming Buffering ------------------------------------------- | |
(defn- maybe-add-disable-buffering-header [{:keys [body], :as response}]
(cond-> response
(or (instance? StreamingResponse body)
(instance? ManyToManyChannel body))
(assoc-in [:headers "X-Accel-Buffering"] "no"))) | |
Tell nginx not to batch streaming responses -- otherwise load balancers are liable to cancel our request prematurely if they aren't configured for longer timeouts. See https://nginx.org/en/docs/http/ngxhttpproxymodule.html#proxycache | (defn disable-streaming-buffering
[handler]
(fn [request respond raise]
(handler
request
(comp respond maybe-add-disable-buffering-header)
raise))) |
-------------------------------------------------- Bind request -------------------------------------------------- | |
The Ring request currently being handled by this thread, if any. | (def ^:dynamic *request* nil) |
Ring middleware that binds | (defn bind-request
[handler]
(fn [request respond raise]
(binding [*request* request]
(handler request respond raise)))) |
(ns metabase.server.middleware.offset-paging (:require [medley.core :as m] [metabase.server.middleware.security :as mw.security] [metabase.util.i18n :refer [tru]])) | |
(set! *warn-on-reflection* true) | |
Limit for offset-limit paging. | (def ^:dynamic *limit* nil) (def ^:private default-limit 50) |
Offset for offset-limit paging. | (def ^:dynamic *offset* nil) (def ^:private default-offset 0) |
Bool for whether a request is paged or not. Automatically generated by a handler in offset-paging middleware. | (def ^:dynamic *paged?* false) |
(defn- offset-paged? [{{:strs [page limit offset]} :query-params}]
(or page limit offset)) | |
(defn- parse-paging-params [{{:strs [limit offset]} :query-params}]
(let [limit (or (some-> limit Integer/parseUnsignedInt)
default-limit)
offset (or (some-> offset Integer/parseUnsignedInt)
default-offset)]
{:limit limit, :offset offset})) | |
(defn- with-paging-params [request {:keys [limit offset]}]
(-> request
(assoc ::limit limit, ::offset offset)
(m/dissoc-in [:query-params "offset"])
(m/dissoc-in [:query-params "limit"])
(m/dissoc-in [:params :offset])
(m/dissoc-in [:params :limit]))) | |
Limit offset paging. This has many downsides but many upsides, chief among them at-will random paging. (it isn't stable with respect to underlying data changing, though) | (defn handle-paging
[handler]
(fn [request respond raise]
(if-not (offset-paged? request)
(handler request respond raise)
(let [paging-params (try
(parse-paging-params request)
(catch Throwable e
e))]
(if (instance? Throwable paging-params)
(let [^Throwable e paging-params]
(respond {:status 400
:headers (mw.security/security-headers)
:body (merge
(Throwable->map e)
{:message (tru "Error parsing paging parameters: {0}" (ex-message e))})}))
(let [{:keys [limit offset]} paging-params
request (with-paging-params request paging-params)]
(binding [*limit* limit
*offset* offset
*paged?* true]
(handler request respond raise)))))))) |
Ring middleware for adding security-related headers to API responses. | (ns metabase.server.middleware.security (:require [clojure.java.io :as io] [clojure.string :as str] [java-time.api :as t] [metabase.analytics.snowplow :as snowplow] [metabase.config :as config] [metabase.embed.settings :as embed.settings] [metabase.models.setting :refer [defsetting]] [metabase.public-settings :as public-settings] [metabase.server.request.util :as request.u] [metabase.util.i18n :refer [deferred-tru]] [ring.util.codec :refer [base64-encode]]) (:import (java.security MessageDigest SecureRandom))) |
(set! *warn-on-reflection* true) | |
Generates a random nonce of 10 characters to add to the | (defn- generate-nonce
[]
(let [chars "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
secure-random (SecureRandom.)]
(apply str (repeatedly 10 #(get chars (.nextInt secure-random (count chars))))))) |
(defonce ^:private ^:const inline-js-hashes
(letfn [(file-hash [resource-filename]
(base64-encode
(.digest (doto (MessageDigest/getInstance "SHA-256")
(.update (.getBytes (slurp (io/resource resource-filename))))))))]
(mapv file-hash [ ;; inline script in index.html that sets `MetabaseBootstrap` and the like
"frontend_client/inline_js/index_bootstrap.js"
;; inline script in index.html that loads Google Analytics
"frontend_client/inline_js/index_ganalytics.js"
;; inline script in init.html
"frontend_client/inline_js/init.js"]))) | |
Headers that tell browsers not to cache a response. | (defn- cache-prevention-headers
[]
{"Cache-Control" "max-age=0, no-cache, must-revalidate, proxy-revalidate"
"Expires" "Tue, 03 Jul 2001 06:00:00 GMT"
"Last-Modified" (t/format :rfc-1123-date-time (t/zoned-date-time))}) |
Headers that tell browsers to cache a static resource for a long time. | (defn- cache-far-future-headers
[]
{"Cache-Control" "public, max-age=31536000"}) |
Tell browsers to only access this resource over HTTPS for the next year (prevent MTM attacks). (This only applies if the original request was HTTPS; if sent in response to an HTTP request, this is simply ignored) | (def ^:private ^:const strict-transport-security-header
{"Strict-Transport-Security" "max-age=31536000"}) |
| (defn- content-security-policy-header
[nonce]
{"Content-Security-Policy"
(str/join
(for [[k vs] {:default-src ["'none'"]
:script-src (concat
["'self'"
"https://maps.google.com"
"https://accounts.google.com"
(when (public-settings/anon-tracking-enabled)
"https://www.google-analytics.com")
;; for webpack hot reloading
(when config/is-dev?
"http://localhost:8080")
;; for react dev tools to work in Firefox until resolution of
;; https://github.com/facebook/react/issues/17997
(when config/is-dev?
"'unsafe-inline'")]
;; CLJS REPL
(when config/is-dev?
["'unsafe-eval'"
"http://localhost:9630"])
(when-not config/is-dev?
(map (partial format "'sha256-%s'") inline-js-hashes)))
:child-src ["'self'"
;; TODO - double check that we actually need this for Google Auth
"https://accounts.google.com"]
:style-src ["'self'"
;; See [[generate-nonce]]
(when nonce
(format "'nonce-%s'" nonce))
;; for webpack hot reloading
(when config/is-dev?
"http://localhost:8080")
;; CLJS REPL
(when config/is-dev?
"http://localhost:9630")
"https://accounts.google.com"]
:font-src ["*"]
:img-src ["*"
"'self' data:"]
:connect-src ["'self'"
;; Google Identity Services
"https://accounts.google.com"
;; MailChimp. So people can sign up for the Metabase mailing list in the sign up process
"metabase.us10.list-manage.com"
;; Google analytics
(when (public-settings/anon-tracking-enabled)
"www.google-analytics.com")
;; Snowplow analytics
(when (public-settings/anon-tracking-enabled)
(snowplow/snowplow-url))
;; Webpack dev server
(when config/is-dev?
"*:8080 ws://*:8080")
;; CLJS REPL
(when config/is-dev?
"ws://*:9630")]
:manifest-src ["'self'"]}]
(format "%s %s; " (name k) (str/join " " vs))))}) |
(defn- embedding-app-origin
[]
(when (and (embed.settings/enable-embedding) (embed.settings/embedding-app-origin))
(embed.settings/embedding-app-origin))) | |
(defn- content-security-policy-header-with-frame-ancestors
[allow-iframes? nonce]
(update (content-security-policy-header nonce)
"Content-Security-Policy"
#(format "%s frame-ancestors %s;" % (if allow-iframes? "*" (or (embedding-app-origin) "'none'"))))) | |
(defsetting ssl-certificate-public-key
(deferred-tru
(str "Base-64 encoded public key for this site''s SSL certificate. "
"Specify this to enable HTTP Public Key Pinning. "
"See {0} for more information.")
"http://mzl.la/1EnfqBf")
:audit :getter) | |
TODO - it would be nice if we could make this a proper link in the UI; consider enabling markdown parsing | |
Return only the first embedding app origin. | (defn- first-embedding-app-origin
[]
(some-> (embedding-app-origin)
(str/split #" ")
first)) |
Fetch a map of security headers that should be added to a response based on the passed options. | (defn security-headers
[& {:keys [nonce allow-iframes? allow-cache?]
:or {allow-iframes? false, allow-cache? false}}]
(merge
(if allow-cache?
(cache-far-future-headers)
(cache-prevention-headers))
strict-transport-security-header
(content-security-policy-header-with-frame-ancestors allow-iframes? nonce)
(when-not allow-iframes?
;; Tell browsers not to render our site as an iframe (prevent clickjacking)
{"X-Frame-Options" (if (embedding-app-origin)
(format "ALLOW-FROM %s" (first-embedding-app-origin))
"DENY")})
{ ;; Tell browser to block suspected XSS attacks
"X-XSS-Protection" "1; mode=block"
;; Prevent Flash / PDF files from including content from site.
"X-Permitted-Cross-Domain-Policies" "none"
;; Tell browser not to use MIME sniffing to guess types of files -- protect against MIME type confusion attacks
"X-Content-Type-Options" "nosniff"})) |
(defn- add-security-headers* [request response]
(update response :headers merge (security-headers
:nonce (:nonce request)
:allow-iframes? ((some-fn request.u/public? request.u/embed?) request)
:allow-cache? (request.u/cacheable? request)))) | |
Middleware that adds HTTP security and cache-busting headers. | (defn add-security-headers
[handler]
(fn [request respond raise]
(let [request (assoc request :nonce (generate-nonce))]
(handler
request
(comp respond (partial add-security-headers* request))
raise)))) |
Ring middleware related to session and API-key based authentication (binding current user and permissions). How do authenticated API requests work? There are two main paths to authentication: a session or an API key. For session authentication, Metabase first looks for a cookie called Finally we'll check for the presence of a The second main path to authentication is an API key. For this, we look at the | (ns metabase.server.middleware.session
(:require
[honey.sql.helpers :as sql.helpers]
[java-time.api :as t]
[metabase.api.common
:as api
:refer [*current-user*
*current-user-id*
*current-user-permissions-set*
*is-group-manager?*
*is-superuser?*]]
[metabase.config :as config]
[metabase.core.initialization-status :as init-status]
[metabase.db :as mdb]
[metabase.driver.sql.query-processor :as sql.qp]
[metabase.models.api-key :as api-key]
[metabase.models.setting
:as setting
:refer [*user-local-values* defsetting]]
[metabase.models.user :as user :refer [User]]
[metabase.public-settings :as public-settings]
[metabase.public-settings.premium-features :as premium-features]
[metabase.server.request.util :as request.u]
[metabase.util :as u]
[metabase.util.i18n :as i18n :refer [deferred-trs deferred-tru trs tru]]
[metabase.util.log :as log]
[metabase.util.password :as u.password]
[ring.util.response :as response]
[schema.core :as s]
[toucan2.core :as t2]
[toucan2.pipeline :as t2.pipeline])
(:import
(java.util UUID))) |
(def ^:private ^String metabase-session-cookie "metabase.SESSION") (def ^:private ^String metabase-embedded-session-cookie "metabase.EMBEDDED_SESSION") (def ^:private ^String metabase-session-timeout-cookie "metabase.TIMEOUT") (def ^:private ^String anti-csrf-token-header "x-metabase-anti-csrf-token") | |
(defn- clear-cookie [response cookie-name]
(response/set-cookie response cookie-name nil {:expires "Thu, 1 Jan 1970 00:00:00 GMT", :path "/"})) | |
You can't add a cookie (by setting the | (defn- wrap-body-if-needed
[response]
(if (and (map? response) (contains? response :body))
response
{:body response, :status 200})) |
Add a header to | (defn clear-session-cookie
[response]
(reduce clear-cookie (wrap-body-if-needed response) [metabase-session-cookie
metabase-embedded-session-cookie
metabase-session-timeout-cookie])) |
(def ^:private possible-session-cookie-samesite-values
#{:lax :none :strict nil}) | |
(defn- normalized-session-cookie-samesite [value] (some-> value name u/lower-case-en keyword)) | |
(defn- valid-session-cookie-samesite? [normalized-value] (contains? possible-session-cookie-samesite-values normalized-value)) | |
(defsetting session-cookie-samesite
(deferred-tru "Value for the session cookie's `SameSite` directive.")
:type :keyword
:visibility :settings-manager
:default :lax
:getter (fn session-cookie-samesite-getter []
(let [value (normalized-session-cookie-samesite
(setting/get-raw-value :session-cookie-samesite))]
(if (valid-session-cookie-samesite? value)
value
(throw (ex-info "Invalid value for session cookie samesite"
{:possible-values possible-session-cookie-samesite-values
:session-cookie-samesite value})))))
:setter (fn session-cookie-samesite-setter
[new-value]
(let [normalized-value (normalized-session-cookie-samesite new-value)]
(if (valid-session-cookie-samesite? normalized-value)
(setting/set-value-of-type!
:keyword
:session-cookie-samesite
normalized-value)
(throw (ex-info (tru "Invalid value for session cookie samesite")
{:possible-values possible-session-cookie-samesite-values
:session-cookie-samesite normalized-value
:http-status 400})))))) | |
The appropriate cookie attributes to persist a newly created Session to | (defmulti default-session-cookie-attributes
{:arglists '([session-type request])}
(fn [session-type _] session-type)) |
(defmethod default-session-cookie-attributes :default
[session-type _]
(throw (ex-info (str (tru "Invalid session-type."))
{:session-type session-type}))) | |
(defmethod default-session-cookie-attributes :normal
[_ request]
(merge
{:same-site (session-cookie-samesite)
;; TODO - we should set `site-path` as well. Don't want to enable this yet so we don't end
;; up breaking things
:path "/" #_(site-path)}
;; If the authentication request request was made over HTTPS (hopefully always except for
;; local dev instances) add `Secure` attribute so the cookie is only sent over HTTPS.
(when (request.u/https? request)
{:secure true}))) | |
(defmethod default-session-cookie-attributes :full-app-embed
[_ request]
(merge
{:path "/"}
(when (request.u/https? request)
;; SameSite=None is required for cross-domain full-app embedding. This is safe because
;; security is provided via anti-CSRF token. Note that most browsers will only accept
;; SameSite=None with secure cookies, thus we are setting it only over HTTPS to prevent
;; the cookie from being rejected in case of same-domain embedding.
{:same-site :none
:secure true}))) | |
(declare session-timeout-seconds) | |
Add an appropriate timeout cookie to track whether the session should timeout or not, according to the [[session-timeout]] setting. If the session-timeout setting is on, the cookie has an appropriately timed expires attribute. If the session-timeout setting is off, the cookie has a max-age attribute, so it expires in the far future. | (defn set-session-timeout-cookie
[response request session-type request-time]
(let [response (wrap-body-if-needed response)
timeout (session-timeout-seconds)
cookie-options (merge
(default-session-cookie-attributes session-type request)
(if (some? timeout)
{:expires (t/format :rfc-1123-date-time (t/plus request-time (t/seconds timeout)))}
{:max-age (* 60 (config/config-int :max-session-age))}))]
(-> response
wrap-body-if-needed
(response/set-cookie metabase-session-timeout-cookie "alive" cookie-options)))) |
Returns the appropriate cookie name for the session type. | (defn session-cookie-name
[session-type]
(case session-type
:normal
metabase-session-cookie
:full-app-embed
metabase-embedded-session-cookie)) |
Check if we should use permanent cookies for a given request, which are not cleared when a browser sesion ends. | (defn- use-permanent-cookies?
[request]
(if (public-settings/session-cookies)
;; Disallow permanent cookies if MB_SESSION_COOKIES is set
false
;; Otherwise check whether the user selected "remember me" during login
(get-in request [:body :remember]))) |
Add the appropriate cookies to the | (s/defn set-session-cookies
[request
response
{session-uuid :id
session-type :type
anti-csrf-token :anti_csrf_token} :- {:id (s/cond-pre UUID u/uuid-regex), s/Keyword s/Any}
request-time]
(let [cookie-options (merge
(default-session-cookie-attributes session-type request)
{:http-only true}
;; If permanent cookies should be used, set the `Max-Age` directive; cookies with no
;; `Max-Age` and no `Expires` directives are session cookies, and are deleted when the
;; browser is closed.
;; See https://developer.mozilla.org/en-US/docs/Web/HTTP/Cookies#define_the_lifetime_of_a_cookie
;; max-session age-is in minutes; Max-Age= directive should be in seconds
(when (use-permanent-cookies? request)
{:max-age (* 60 (config/config-int :max-session-age))}))]
(when (and (= (session-cookie-samesite) :none) (not (request.u/https? request)))
(log/warn
(str (deferred-trs "Session cookie's SameSite is configured to \"None\", but site is served over an insecure connection. Some browsers will reject cookies under these conditions.")
" "
"https://www.chromestatus.com/feature/5633521622188032")))
(-> response
wrap-body-if-needed
(cond-> (= session-type :full-app-embed)
(assoc-in [:headers anti-csrf-token-header] anti-csrf-token))
(set-session-timeout-cookie request session-type request-time)
(response/set-cookie (session-cookie-name session-type) (str session-uuid) cookie-options)))) |
+----------------------------------------------------------------------------------------------------------------+ | wrap-session-id | +----------------------------------------------------------------------------------------------------------------+ | |
(def ^:private ^String metabase-session-header "x-metabase-session") | |
Attempt to add | (defmulti ^:private wrap-session-id-with-strategy
{:arglists '([strategy request])}
(fn [strategy _]
strategy)) |
(defmethod wrap-session-id-with-strategy :embedded-cookie
[_ {:keys [cookies headers], :as request}]
(when-let [session (get-in cookies [metabase-embedded-session-cookie :value])]
(when-let [anti-csrf-token (get headers anti-csrf-token-header)]
(assoc request :metabase-session-id session, :anti-csrf-token anti-csrf-token :metabase-session-type :full-app-embed)))) | |
(defmethod wrap-session-id-with-strategy :normal-cookie
[_ {:keys [cookies], :as request}]
(when-let [session (get-in cookies [metabase-session-cookie :value])]
(when (seq session)
(assoc request :metabase-session-id session :metabase-session-type :normal)))) | |
(defmethod wrap-session-id-with-strategy :header
[_ {:keys [headers], :as request}]
(when-let [session (get headers metabase-session-header)]
(when (seq session)
(assoc request :metabase-session-id session)))) | |
(defmethod wrap-session-id-with-strategy :best
[_ request]
(some
(fn [strategy]
(wrap-session-id-with-strategy strategy request))
[:embedded-cookie :normal-cookie :header])) | |
Middleware that sets the | (defn wrap-session-id
[handler]
(fn [request respond raise]
(let [request (or (wrap-session-id-with-strategy :best request)
request)]
(handler request respond raise)))) |
+----------------------------------------------------------------------------------------------------------------+ | wrap-current-user-info | +----------------------------------------------------------------------------------------------------------------+ | |
Because this query runs on every single API request it's worth it to optimize it a bit and only compile it to SQL once rather than every time | (def ^:private ^{:arglists '([db-type max-age-minutes session-type enable-advanced-permissions?])} session-with-id-query
(memoize
(fn [db-type max-age-minutes session-type enable-advanced-permissions?]
(first
(t2.pipeline/compile*
(cond-> {:select [[:session.user_id :metabase-user-id]
[:user.is_superuser :is-superuser?]
[:user.locale :user-locale]]
:from [[:core_session :session]]
:left-join [[:core_user :user] [:= :session.user_id :user.id]]
:where [:and
[:= :user.is_active true]
[:= :session.id [:raw "?"]]
(let [oldest-allowed [:inline (sql.qp/add-interval-honeysql-form db-type
:%now
(- max-age-minutes)
:minute)]]
[:> :session.created_at oldest-allowed])
[:= :session.anti_csrf_token (case session-type
:normal nil
:full-app-embed [:raw "?"])]]
:limit [:inline 1]}
enable-advanced-permissions?
(->
(sql.helpers/select
[:pgm.is_group_manager :is-group-manager?])
(sql.helpers/left-join
[:permissions_group_membership :pgm] [:and
[:= :pgm.user_id :user.id]
[:is :pgm.is_group_manager true]])))))))) |
See above: because this query runs on every single API request (with an API Key) it's worth it to optimize it a bit and only compile it to SQL once rather than every time | (def ^:private ^{:arglists '([enable-advanced-permissions?])} user-data-for-api-key-prefix-query
(memoize
(fn [enable-advanced-permissions?]
(first
(t2.pipeline/compile*
(cond-> {:select [[:api_key.user_id :metabase-user-id]
[:api_key.key :api-key]
[:user.is_superuser :is-superuser?]
[:user.locale :user-locale]]
:from :api_key
:left-join [[:core_user :user] [:= :api_key.user_id :user.id]]
:where [:and
[:= :user.is_active true]
[:= :api_key.key_prefix [:raw "?"]]]
:limit [:inline 1]}
enable-advanced-permissions?
(->
(sql.helpers/select
[:pgm.is_group_manager :is-group-manager?])
(sql.helpers/left-join
[:permissions_group_membership :pgm] [:and
[:= :pgm.user_id :user.id]
[:is :pgm.is_group_manager true]])))))))) |
Return User ID and superuser status for Session with | (defn- current-user-info-for-session
[session-id anti-csrf-token]
(when (and session-id (init-status/complete?))
(let [sql (session-with-id-query (mdb/db-type)
(config/config-int :max-session-age)
(if (seq anti-csrf-token) :full-app-embed :normal)
(premium-features/enable-advanced-permissions?))
params (concat [session-id]
(when (seq anti-csrf-token)
[anti-csrf-token]))]
(some-> (t2/query-one (cons sql params))
;; is-group-manager? could return `nil, convert it to boolean so it's guaranteed to be only true/false
(update :is-group-manager? boolean))))) |
(def ^:private api-key-that-should-never-match (str (random-uuid))) (def ^:private hash-that-should-never-match (u.password/hash-bcrypt "password")) | |
(defn- do-useless-hash [] (u.password/verify-password api-key-that-should-never-match hash-that-should-never-match)) | |
(defn- matching-api-key? [{:keys [api-key] :as _user-data} passed-api-key]
;; if we get an API key, check the hash against the passed value. If not, don't reveal info via a timing attack - do
;; a useless hash, *then* return `false`.
(if api-key
(u.password/verify-password passed-api-key api-key)
(do-useless-hash))) | |
Return User ID and superuser status for an API Key with `api-key-id | (defn- current-user-info-for-api-key
[api-key]
(when (and api-key (init-status/complete?))
(let [user-data (some-> (t2/query-one (cons (user-data-for-api-key-prefix-query
(premium-features/enable-advanced-permissions?))
[(api-key/prefix api-key)]))
(update :is-group-manager? boolean))]
(when (matching-api-key? user-data api-key)
(dissoc user-data :api-key))))) |
(defn- merge-current-user-info
[{:keys [metabase-session-id anti-csrf-token], {:strs [x-metabase-locale x-api-key]} :headers, :as request}]
(merge
request
(or (current-user-info-for-session metabase-session-id anti-csrf-token)
(current-user-info-for-api-key x-api-key))
(when x-metabase-locale
(log/tracef "Found X-Metabase-Locale header: using %s as user locale" (pr-str x-metabase-locale))
{:user-locale (i18n/normalized-locale-string x-metabase-locale)}))) | |
Add | (defn wrap-current-user-info
[handler]
(fn [request respond raise]
(handler (merge-current-user-info request) respond raise))) |
+----------------------------------------------------------------------------------------------------------------+ | bind-current-user | +----------------------------------------------------------------------------------------------------------------+ | |
(def ^:private current-user-fields (into [User] user/admin-or-self-visible-columns)) | |
(defn- find-user [user-id]
(when user-id
(t2/select-one current-user-fields, :id user-id))) | |
User ID that we've previous bound [[user-local-values]] for. This exists so we can avoid rebinding it in recursive calls to [[with-current-user]] if it is already bound, as this can mess things up since things like [[metabase.models.setting/set-user-local-value!]] will only update the values for the top-level binding. | (def ^:private ^:dynamic *user-local-values-user-id* ;; placeholder value so we will end up rebinding [[*user-local-values*]] it if you call ;; ;; (with-current-user nil ;; ...) ;; ::none) |
Impl for [[with-current-user]]. | (defn do-with-current-user
[{:keys [metabase-user-id is-superuser? permissions-set user-locale settings is-group-manager?]} thunk]
(binding [*current-user-id* metabase-user-id
i18n/*user-locale* user-locale
*is-group-manager?* (boolean is-group-manager?)
*is-superuser?* (boolean is-superuser?)
*current-user* (delay (find-user metabase-user-id))
*current-user-permissions-set* (delay (or permissions-set (some-> metabase-user-id user/permissions-set)))
;; as mentioned above, do not rebind this to something new, because changes to its value will not be
;; propagated to frames further up the stack
*user-local-values* (if (= *user-local-values-user-id* metabase-user-id)
*user-local-values*
(delay (atom (or settings
(user/user-local-settings metabase-user-id)))))
*user-local-values-user-id* metabase-user-id]
(thunk))) |
(defmacro ^:private with-current-user-for-request [request & body] `(do-with-current-user ~request (fn [] ~@body))) | |
Middleware that binds [[metabase.api.common/current-user]], [[current-user-id]], [[is-superuser?]], [[current-user-permissions-set]], and [[metabase.models.setting/user-local-values]].
| (defn bind-current-user
[handler]
(fn [request respond raise]
(with-current-user-for-request request
(handler request respond raise)))) |
Part of the impl for | (defn with-current-user-fetch-user-for-id
[current-user-id]
(when current-user-id
(t2/select-one [User [:id :metabase-user-id] [:is_superuser :is-superuser?] [:locale :user-locale] :settings]
:id current-user-id))) |
Execude code in body as an admin user. | (defmacro as-admin
{:style/indent :defn}
[& body]
`(do-with-current-user
(merge
(with-current-user-fetch-user-for-id ~`api/*current-user-id*)
{:is-superuser? true
:permissions-set #{"/"}})
(fn [] ~@body))) |
Execute code in body with | (defmacro with-current-user
{:style/indent :defn}
[current-user-id & body]
`(do-with-current-user
(with-current-user-fetch-user-for-id ~current-user-id)
(fn [] ~@body))) |
+----------------------------------------------------------------------------------------------------------------+ | reset-cookie-timeout | +----------------------------------------------------------------------------------------------------------------+ | |
Returns nil if the [[session-timeout]] value is valid. Otherwise returns an error key. | (defn- check-session-timeout
[timeout]
(when (some? timeout)
(let [{:keys [unit amount]} timeout
units-in-24-hours (case unit
"seconds" (* 60 60 24)
"minutes" (* 60 24)
"hours" 24)
units-in-100-years (* units-in-24-hours 365.25 100)]
(cond
(not (pos? amount))
:amount-must-be-positive
(>= amount units-in-100-years)
:amount-must-be-less-than-100-years)))) |
(defsetting session-timeout
;; Should be in the form "{\"amount\":60,\"unit\":\"minutes\"}" where the unit is one of "seconds", "minutes" or "hours".
;; The amount is nillable.
(deferred-tru "Time before inactive users are logged out. By default, sessions last indefinitely.")
:type :json
:default nil
:getter (fn []
(let [value (setting/get-value-of-type :json :session-timeout)]
(if-let [error-key (check-session-timeout value)]
(do (log/warn (case error-key
:amount-must-be-positive (trs "Session timeout amount must be positive.")
:amount-must-be-less-than-100-years (trs "Session timeout must be less than 100 years.")))
nil)
value)))
:setter (fn [new-value]
(when-let [error-key (check-session-timeout new-value)]
(throw (ex-info (case error-key
:amount-must-be-positive (tru "Session timeout amount must be positive.")
:amount-must-be-less-than-100-years (tru "Session timeout must be less than 100 years."))
{:status-code 400})))
(setting/set-value-of-type! :json :session-timeout new-value))) | |
Convert the session-timeout setting value to seconds. | (defn session-timeout->seconds
[{:keys [unit amount]}]
(when amount
(-> (case unit
"seconds" amount
"minutes" (* amount 60)
"hours" (* amount 3600))
(max 60)))) ; Ensure a minimum of 60 seconds so a user can't lock themselves out |
Returns the number of seconds before a session times out. An alternative to calling | (defn session-timeout-seconds [] (session-timeout->seconds (session-timeout))) |
Implementation for | (defn reset-session-timeout*
[request response request-time]
(if (and
;; Only reset the timeout if the request includes a session cookie.
(:metabase-session-type request)
;; Do not reset the timeout if it is being updated in the response, e.g. if it is being deleted
(not (contains? (:cookies response) metabase-session-timeout-cookie)))
(set-session-timeout-cookie response request (:metabase-session-type request) request-time)
response)) |
Middleware that resets the expiry date on session cookies according to the session-timeout setting. Will not change anything if the session-timeout setting is nil, or the timeout cookie has already expired. | (defn reset-session-timeout
[handler]
(fn [request respond raise]
(let [;; The expiry time for the cookie is relative to the time the request is received, rather than the time of the response.
request-time (t/zoned-date-time (t/zone-id "GMT"))]
(handler request
(fn [response]
(respond (reset-session-timeout* request response request-time)))
raise)))) |
Middleware for redirecting users to HTTPS sessions | (ns metabase.server.middleware.ssl (:require [clojure.string :as str] [metabase.public-settings :as public-settings] [metabase.server.request.util :as request.u] [ring.util.request :as req] [ring.util.response :as response])) |
(set! *warn-on-reflection* true) | |
The set of URLs that should not be forced to redirect to their HTTPS equivalents | (def no-redirect-https-uris
#{"/api/health"}) |
(defn- get-request? [{method :request-method}]
(or (= method :head)
(= method :get))) | |
(defn- https-url [url-string]
(let [url (java.net.URL. url-string)
site-url (java.net.URL. (public-settings/site-url))]
(str (java.net.URL. "https" (.getHost site-url) (.getPort site-url) (.getFile url))))) | |
Given a HTTP request, return a redirect response to the equivalent HTTPS URL. | (defn- ssl-redirect-response
[request]
(-> (response/redirect (https-url (req/request-url request)))
(response/status (if (get-request? request) 301 307)))) |
Redirect users to HTTPS sessions when certain conditions are met.
See | (defn redirect-to-https-middleware
[handler]
(fn [request respond raise]
(cond
(str/blank? (public-settings/site-url))
(handler request respond raise)
(not (str/starts-with? (public-settings/site-url) "https:"))
(handler request respond raise)
(no-redirect-https-uris (:uri request))
(handler request respond raise)
(and
(public-settings/redirect-all-requests-to-https)
(not (request.u/https? request)))
(respond (ssl-redirect-response request))
:else (handler request respond raise)))) |
Ring middleware utility functions. TODO -- consider renaming this to | (ns metabase.server.middleware.util) |
Generic Generic | (def response-unauthentic {:status 401, :body "Unauthenticated"})
(def response-forbidden {:status 403, :body "Forbidden"}) |
(ns metabase.server.protocols (:require [potemkin.types :as p.types] [ring.adapter.jetty9.servlet :as servlet])) | |
Protocol for converting API endpoint responses to something Jetty can handle. | (p.types/defprotocol+ Respond
(respond [body context]
"Convert an API endpoint response to something Jetty-friendly. Default impl uses Ring functionality to write the
response to a Jetty `OutputStream`. Things that need more advanced functionality than what Ring provides (such as
the streaming response logic) provide their own custom implementations of this method.
`context` has the following keys:
* `:request` -- `jakarta.servlet.http.HttpServletRequest`
* `:request-map` -- Ring request map
* `:async-context` -- `jakarta.servlet.AsyncContext`
* `:response` -- `jakarta.servlet.http.HttpServletResponse`
* `:response-map` -- Ring response map")) |
(extend-protocol Respond
nil
(respond [_ {:keys [async-context response response-map]}]
(servlet/update-servlet-response response async-context response-map))
Object
(respond [_ {:keys [async-context response response-map]}]
(servlet/update-servlet-response response async-context response-map))) | |
Utility functions for Ring requests. | (ns metabase.server.request.util (:require [cheshire.core :as json] [clj-http.client :as http] [clojure.string :as str] [java-time.api :as t] [metabase.config :as config] [metabase.public-settings :as public-settings] [metabase.util :as u] [metabase.util.i18n :refer [trs tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [user-agent :as user-agent]) (:import (java.time ZoneId))) |
(set! *warn-on-reflection* true) | |
Is this ring request an API call (does path start with | (defn api-call?
[{:keys [^String uri]}]
(str/starts-with? uri "/api")) |
Is this ring request one that will serve | (defn public?
[{:keys [uri]}]
(re-matches #"^/public/.*$" uri)) |
Is this ring request one that will serve | (defn embed?
[{:keys [uri]}]
(re-matches #"^/embed/.*$" uri)) |
Can the ring request be permanently cached? | (defn cacheable?
[{:keys [request-method uri], :as _request}]
(and (= request-method :get)
(or
;; match requests that are js/css and have a cache-busting hex string
(re-matches #"^/app/dist/.+\.[a-f0-9]{20}\.(js|css)$" uri)
;; any resource that is named as a cache-busting hex string (e.g. fonts, images)
(re-matches #"^/app/dist/[a-f0-9]{20}.*$" uri)))) |
True if the original request made by the frontend client (i.e., browser) was made over HTTPS. In many production instances, a reverse proxy such as an ELB or nginx will handle SSL termination, and the actual request handled by Jetty will be over HTTP. | (defn https?
[{{:strs [x-forwarded-proto x-forwarded-protocol x-url-scheme x-forwarded-ssl front-end-https origin]} :headers
:keys [scheme]}]
(cond
;; If `X-Forwarded-Proto` is present use that. There are several alternate headers that mean the same thing. See
;; https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/X-Forwarded-Proto
(or x-forwarded-proto x-forwarded-protocol x-url-scheme)
(= "https" (u/lower-case-en (or x-forwarded-proto x-forwarded-protocol x-url-scheme)))
;; If none of those headers are present, look for presence of `X-Forwarded-Ssl` or `Frontend-End-Https`, which
;; will be set to `on` if the original request was over HTTPS.
(or x-forwarded-ssl front-end-https)
(= "on" (u/lower-case-en (or x-forwarded-ssl front-end-https)))
;; If none of the above are present, we are most not likely being accessed over a reverse proxy. Still, there's a
;; good chance `Origin` will be present because it should be sent with `POST` requests, and most auth requests are
;; `POST`. See https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Origin
origin
(str/starts-with? (u/lower-case-en origin) "https")
;; Last but not least, if none of the above are set (meaning there are no proxy servers such as ELBs or nginx in
;; front of us), we can look directly at the scheme of the request sent to Jetty.
scheme
(= scheme :https))) |
Whether this frontend client that made this request is embedded inside an | (defn embedded? [request] (some-> request (get-in [:headers "x-metabase-embedded"]) Boolean/parseBoolean)) |
The IP address a Ring | (defn ip-address
[{:keys [headers remote-addr]}]
(some-> (or (some->> (public-settings/source-address-header) (get headers))
remote-addr)
;; first IP (if there are multiple) is the actual client -- see
;; https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/X-Forwarded-For
(str/split #"\s*,\s*")
first
;; strip out non-ip-address characters like square brackets which we get sometimes
(str/replace #"[^0-9a-fA-F.:]" ""))) |
Schema for the device info returned by | (def DeviceInfo
[:map {:closed true}
[:device_id ms/NonBlankString]
[:device_description ms/NonBlankString]
[:ip_address ms/NonBlankString]]) |
(mu/defn device-info :- DeviceInfo
"Information about the device that made this request, as recorded by the `LoginHistory` table."
[{{:strs [user-agent]} :headers, :keys [browser-id], :as request}]
(let [id (or browser-id
(log/warn (trs "Login request is missing device ID information")))
description (or user-agent
(log/warn (trs "Login request is missing user-agent information")))
ip-address (or (ip-address request)
(log/warn (trs "Unable to determine login request IP address")))]
(when-not (and id description ip-address)
(log/warn (tru "Error determining login history for request")))
{:device_id (or id (trs "unknown"))
:device_description (or description (trs "unknown"))
:ip_address (or ip-address (trs "unknown"))})) | |
Format a user-agent string from a request in a human-friendly way. | (defn describe-user-agent
[user-agent-string]
(when-not (str/blank? user-agent-string)
(when-let [{device-type :type-name
{os-name :name} :os
browser-name :name} (some-> user-agent-string user-agent/parse not-empty)]
(let [non-blank (fn [s]
(when-not (str/blank? s)
s))
device-type (or (non-blank device-type)
(tru "Unknown device type"))
os-name (or (non-blank os-name)
(tru "Unknown OS"))
browser-name (or (non-blank browser-name)
(tru "Unknown browser"))]
(format "%s (%s/%s)" device-type browser-name os-name))))) |
(defn- describe-location [{:keys [city region country]}]
(when-let [info (not-empty (remove str/blank? [city region country]))]
(str/join ", " info))) | |
Max amount of time to wait for a IP address geocoding request to complete. We send emails on the first login from a new device using this information, so the timeout has to be fairly short in case the request is hanging for one reason or another. | (def ^:private gecode-ip-address-timeout-ms 5000) |
(def ^:private IPAddress->Info
[:map-of
[:and {:error/message "valid IP address string"}
ms/NonBlankString [:fn u/ip-address?]]
[:map {:closed true}
[:description ms/NonBlankString]
[:timezone [:maybe (ms/InstanceOfClass ZoneId)]]]]) | |
TODO -- replace with something better, like built-in database once we find one that's GPL compatible | (mu/defn geocode-ip-addresses :- [:maybe IPAddress->Info]
"Geocode multiple IP addresses, returning a map of IP address -> info, with each info map containing human-friendly
`:description` of the location and a `java.time.ZoneId` `:timezone`, if that information is available."
[ip-addresses :- [:maybe [:sequential :string]]]
(let [ip-addresses (set (filter u/ip-address? ip-addresses))]
(when (seq ip-addresses)
(let [url (str "https://get.geojs.io/v1/ip/geo.json?ip=" (str/join "," ip-addresses))]
(try
(let [response (-> (http/get url {:headers {"User-Agent" config/mb-app-id-string}
:socket-timeout gecode-ip-address-timeout-ms
:connection-timeout gecode-ip-address-timeout-ms})
:body
(json/parse-string true))]
(into {} (for [info response]
[(:ip info) {:description (or (describe-location info)
"Unknown location")
:timezone (u/ignore-exceptions (some-> (:timezone info) t/zone-id))}])))
(catch Throwable e
(log/error e (trs "Error geocoding IP addresses") {:url url})
nil)))))) |
Main Compojure routes tables. See https://github.com/weavejester/compojure/wiki/Routes-In-Detail for details about
how these work. | (ns metabase.server.routes (:require [compojure.core :refer [context defroutes GET]] [compojure.route :as route] [metabase.api.dataset :as api.dataset] [metabase.api.routes :as api] [metabase.config :as config] [metabase.core.initialization-status :as init-status] [metabase.db.connection :as mdb.connection] [metabase.db.connection-pool-setup :as mdb.connection-pool-setup] [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn] [metabase.plugins.classloader :as classloader] [metabase.public-settings :as public-settings] [metabase.server.routes.index :as index] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [ring.util.response :as response])) |
(when config/ee-available? (classloader/require '[metabase-enterprise.sso.api.routes :as ee.sso.routes])) | |
Like | (defn- redirect-including-query-string
[url]
(fn [{:keys [query-string]} respond _]
(respond (response/redirect (str url "?" query-string))))) |
/public routes. /public/question/:uuid.:export-format redirects to /api/public/card/:uuid/query/:export-format | (defroutes ^:private public-routes
(GET ["/question/:uuid.:export-format", :uuid u/uuid-regex, :export-format api.dataset/export-format-regex]
[uuid export-format]
(redirect-including-query-string (format "%s/api/public/card/%s/query/%s" (public-settings/site-url) uuid export-format)))
(GET "*" [] index/public)) |
/embed routes. /embed/question/:token.:export-format redirects to /api/public/card/:token/query/:export-format | (defroutes ^:private embed-routes
(GET ["/question/:token.:export-format", :export-format api.dataset/export-format-regex]
[token export-format]
(redirect-including-query-string (format "%s/api/embed/card/%s/query/%s" (public-settings/site-url) token export-format)))
(GET "*" [] index/embed)) |
Top-level ring routes for Metabase. | (defroutes routes
(or (some-> (resolve 'ee.sso.routes/routes) var-get)
(fn [_ respond _]
(respond nil)))
;; ^/$ -> index.html
(GET "/" [] index/index)
(GET "/favicon.ico" [] (response/resource-response (public-settings/application-favicon-url)))
;; ^/api/health -> Health Check Endpoint
(GET "/api/health" []
(if (init-status/complete?)
(try (if (or (mdb.connection-pool-setup/recent-activity?)
(sql-jdbc.conn/can-connect-with-spec? {:datasource (mdb.connection/data-source)}))
{:status 200, :body {:status "ok"}}
{:status 503 :body {:status "Unable to get app-db connection"}})
(catch Exception e
(log/warn e (trs "Error in api/health database check"))
{:status 503 :body {:status "Error getting app-db connection"}}))
{:status 503, :body {:status "initializing", :progress (init-status/progress)}}))
;; ^/api/ -> All other API routes
(context "/api" [] (fn [& args]
;; Redirect naughty users who try to visit a page other than setup if setup is not yet complete
;;
;; if Metabase is not finished initializing, return a generic error message rather than
;; something potentially confusing like "DB is not set up"
(if-not (init-status/complete?)
{:status 503, :body "Metabase is still initializing. Please sit tight..."}
(apply api/routes args))))
;; ^/app/ -> static files under frontend_client/app
(context "/app" []
(route/resources "/" {:root "frontend_client/app"})
;; return 404 for anything else starting with ^/app/ that doesn't exist
(route/not-found {:status 404, :body "Not found."}))
;; ^/public/ -> Public frontend and download routes
(context "/public" [] public-routes)
;; ^/emebed/ -> Embed frontend and download routes
(context "/embed" [] embed-routes)
;; Anything else (e.g. /user/edit_current) should serve up index.html; React app will handle the rest
(GET "*" [] index/index)) |
Logic related to loading various versions of the index.html template. The actual template lives in
| (ns metabase.server.routes.index (:require [cheshire.core :as json] [clojure.java.io :as io] [clojure.string :as str] [hiccup.util] [metabase.core.initialization-status :as init-status] [metabase.models.setting :as setting] [metabase.public-settings :as public-settings] [metabase.util.embed :as embed] [metabase.util.i18n :as i18n :refer [trs]] [metabase.util.log :as log] [ring.util.response :as response] [stencil.core :as stencil]) (:import (java.io FileNotFoundException))) |
(set! *warn-on-reflection* true) | |
(defn- base-href []
(let [path (some-> (public-settings/site-url) io/as-url .getPath)]
(str path "/"))) | |
(defn- escape-script [s] ;; Escapes text to be included in an inline <script> tag, in particular the string '</script' ;; https://stackoverflow.com/questions/14780858/escape-in-script-tag-contents/23983448#23983448 (str/replace s #"(?i)</script" "</scr\\\\ipt")) | |
(defn- fallback-localization [locale-or-name]
(json/generate-string
{"headers"
{"language" (str locale-or-name)
"plural-forms" "nplurals=2; plural=(n != 1);"}
"translations"
{ {"Metabase" {"msgid" "Metabase"
"msgstr" ["Metabase"]}}}})) | |
(defn- localization-json-file-name [locale-string] (format "frontend_client/app/locales/%s.json" (str/replace locale-string \- \_))) | |
(defn- load-localization* [locale-string]
(or
(when locale-string
(when-not (= locale-string "en")
(try
(slurp (or (io/resource (localization-json-file-name locale-string))
(when-let [fallback-locale (i18n/fallback-locale locale-string)]
(io/resource (localization-json-file-name (str fallback-locale))))
;; don't try to i18n the Exception message below, we have no locale to translate it to!
(throw (FileNotFoundException. (format "Locale '%s' not found." locale-string)))))
(catch Throwable e
(log/warn (.getMessage e))))))
(fallback-localization locale-string))) | |
Load a JSON-encoded map of localized strings for the current user's Locale. | (let [load-fn (memoize load-localization*)]
(defn- load-localization
[locale-override]
(load-fn (or locale-override (i18n/user-locale-string))))) |
(defn- load-inline-js* [resource-name] (slurp (io/resource (format "frontend_client/inline_js/%s.js" resource-name)))) | |
(def ^:private ^{:arglists '([resource-name])} load-inline-js (memoize load-inline-js*)) | |
(defn- load-template [path variables]
(try
(stencil/render-file path variables)
(catch IllegalArgumentException e
(let [message (trs "Failed to load template ''{0}''. Did you remember to build the Metabase frontend?" path)]
(log/error e message)
(throw (Exception. message e)))))) | |
(defn- load-entrypoint-template [entrypoint-name embeddable? {:keys [uri params nonce]}]
(load-template
(str "frontend_client/" entrypoint-name ".html")
(let [{:keys [anon-tracking-enabled google-auth-client-id], :as public-settings} (setting/user-readable-values-map #{:public})]
{:bootstrapJS (load-inline-js "index_bootstrap")
:googleAnalyticsJS (load-inline-js "index_ganalytics")
:bootstrapJSON (escape-script (json/generate-string public-settings))
:userLocalizationJSON (escape-script (load-localization (:locale params)))
:siteLocalizationJSON (escape-script (load-localization (public-settings/site-locale)))
:nonceJSON (escape-script (json/generate-string nonce))
:language (hiccup.util/escape-html (public-settings/site-locale))
:favicon (hiccup.util/escape-html (public-settings/application-favicon-url))
:applicationName (hiccup.util/escape-html (public-settings/application-name))
:uri (hiccup.util/escape-html uri)
:baseHref (hiccup.util/escape-html (base-href))
:embedCode (when embeddable? (embed/head uri))
:enableGoogleAuth (boolean google-auth-client-id)
:enableAnonTracking (boolean anon-tracking-enabled)}))) | |
(defn- load-init-template []
(load-template
"frontend_client/init.html"
{:initJS (load-inline-js "init")})) | |
Response that serves up an entrypoint into the Metabase application, e.g. | (defn- entrypoint
[entrypoint-name embeddable? request respond _raise]
(respond
(-> (response/response (if (init-status/complete?)
(load-entrypoint-template entrypoint-name embeddable? request)
(load-init-template)))
(response/content-type "text/html; charset=utf-8")))) |
main index.html entrypoint. /public index.html entrypoint. /embed index.html entrypoint. | (def index (partial entrypoint "index" (not :embeddable))) (def public (partial entrypoint "public" :embeddable)) (def embed (partial entrypoint "embed" :embeddable)) |
(ns metabase.setup (:require [environ.core :as env] [metabase.config :as config] [metabase.db.connection :as mdb.connection] [metabase.models.setting :as setting :refer [defsetting Setting]] [metabase.util.i18n :refer [deferred-tru tru]] [toucan2.core :as t2])) | |
(set! *warn-on-reflection* true) | |
A token used to signify that an instance has permissions to create the initial User. This is created upon the first launch of Metabase, by the first instance; once used, it is cleared out, never to be used again. | (defsetting setup-token :visibility :public :setter :none :audit :never) |
Function for checking if the supplied string matches our setup token.
Returns boolean | (defn token-match?
[token]
{:pre [(string? token)]}
(= token (setup-token))) |
Create and set a new setup token, if one has not already been created. Returns the newly created token. | (defn create-token!
[]
;; fetch the value directly from the DB; *do not* rely on cached value, in case a different instance came along and
;; already created it
;;
;; TODO -- 95% sure we can just use [[setup-token]] directly now and not worry about manually fetching the env var
;; value or setting DB values and the like
(or (when-let [mb-setup-token (env/env :mb-setup-token)]
(setting/set-value-of-type! :string :setup-token mb-setup-token))
(t2/select-one-fn :value Setting :key "setup-token")
(setting/set-value-of-type! :string :setup-token (str (random-uuid))))) |
(defsetting has-user-setup
(deferred-tru "A value that is true iff the metabase instance has one or more users registered.")
:visibility :public
:type :boolean
:setter (fn [value]
(if (or config/is-dev? config/is-test?)
(setting/set-value-of-type! :boolean :has-user-setup value)
(throw (ex-info (tru "Cannot set `has-user-setup`.")
{:value value}))))
;; Once a User is created it's impossible for this to ever become falsey -- deleting the last User is disallowed.
;; After this returns true once the result is cached and it will continue to return true forever without any
;; additional DB hits.
;;
;; This is keyed by the unique identifier for the application database, to support resetting it in tests or swapping
;; it out in the REPL
:getter (let [app-db-id->user-exists? (atom {})]
(fn []
(let [possible-override (when (or config/is-dev? config/is-test?)
;; allow for overriding in dev and test
(setting/get-value-of-type :boolean :has-user-setup))]
;; override could be false so have to check non-nil
(if (some? possible-override)
possible-override
(or (get @app-db-id->user-exists? (mdb.connection/unique-identifier))
(let [exists? (boolean (seq (t2/select :model/User {:where [:not= :id config/internal-mb-user-id]})))]
(swap! app-db-id->user-exists? assoc (mdb.connection/unique-identifier) exists?)
exists?))))))
:doc false
:audit :never) | |
Formatting for dates, times, and ranges. | (ns metabase.shared.formatting.date (:require [metabase.shared.formatting.constants :as constants] [metabase.shared.formatting.internal.date-builder :as builder] [metabase.shared.formatting.internal.date-formatters :as formatters] [metabase.shared.formatting.internal.date-options :as options] [metabase.shared.util.time :as shared.ut])) |
The range separator is a Unicode en-dash, not an ASCII hyphen. | (def range-separator " \u2013 ") |
-------------------------------------------- Parameter Formatting --------------------------------------------- | (def ^:private parameter-formatters
{:month (builder/->formatter [:year "-" :month-dd])
:quarter (builder/->formatter ["Q" :quarter "-" :year])
:day formatters/big-endian-day}) |
Returns a formatting date string for a datetime used as a parameter to a Card. | (defn ^:export format-for-parameter
[value options]
(let [options (options/prepare-options options)
t (shared.ut/coerce-to-timestamp value options)]
(if (not (shared.ut/valid? t))
;; Fall back to a basic string rendering if we couldn't parse it.
(str value)
(if-let [fmt (parameter-formatters (:unit options))]
;; A few units have special formats.
(fmt t)
;; Otherwise, render as a day or day range.
(let [[start end] (shared.ut/to-range t options)]
(if (shared.ut/same-day? start end)
(formatters/big-endian-day start)
(str (formatters/big-endian-day start) "~" (formatters/big-endian-day end)))))))) |
------------------------------------------------ Format Range ------------------------------------------------- | (defn- format-range-with-unit-inner [[start end] options]
(cond
;; Uncondensed, or in different years: January 1, 2018 - January 23, 2019
(or (not (constants/condense-ranges? options))
(not (shared.ut/same-year? start end)))
(let [fmt (formatters/month-day-year options)]
(str (fmt start) range-separator (fmt end)))
;; Condensed, but different months: January 1 - February 2, 2018
(not (shared.ut/same-month? start end))
(str ((formatters/month-day options) start)
range-separator
((formatters/month-day-year options) end))
;; Condensed, and same month: January 1 - 14, 2018
:else (str ((formatters/month-day options) start)
range-separator
((builder/->formatter [:day-of-month-d ", " :year]) end)))) |
Returns a string with this datetime formatted as a range, rounded to the given | (defn ^:export format-range-with-unit
[value options]
(let [options (options/prepare-options options)
t (shared.ut/coerce-to-timestamp value options)]
(if (shared.ut/valid? t)
(format-range-with-unit-inner (shared.ut/to-range t options) options)
;; Best-effort fallback if we failed to parse - .toString the input.
(str value)))) |
Returns a string with this datetime formatted as a single value, rounded to the given ---------------------------------------------- Format Single Date ----------------------------------------------- | (defn ^:export format-datetime-with-unit
[value options]
(let [{:keys [is-exclude no-range type unit]
:as options} (options/prepare-options options)
t (shared.ut/coerce-to-timestamp value options)]
(cond
is-exclude (case unit
:hour-of-day (formatters/hour-only t)
:day-of-week (formatters/weekday t)
(throw (ex-info "is-exclude option is only compatible with hour-of-day and day-of-week units"
{:options options})))
;; Weeks in tooltips and cells get formatted specially.
(and (= unit :week) (#{"tooltip" "cell"} type) (not no-range))
(format-range-with-unit value options)
:else ((formatters/options->formatter options) t)))) |
The gory details of transforming date and time styles, with units and other options, into formatting functions. This namespace deals with the options only, not with specific dates, and returns reusable formatter functions. | (ns metabase.shared.formatting.internal.date-formatters (:require [clojure.string :as str] [metabase.shared.formatting.constants :as constants] [metabase.shared.formatting.internal.date-builder :as builder] [metabase.util.log :as log])) |
(defn- apply-date-separator [format-list date-separator]
(if date-separator
(for [fmt format-list]
(if (string? fmt)
(str/replace fmt #"/" date-separator)
fmt))
format-list)) | |
(defn- apply-date-abbreviation [format-list]
(for [k format-list]
(case k
:month-full :month-short
":month-full" :month-short
:day-of-week-full :day-of-week-short
":day-of-week-full" :day-of-week-short
k))) | |
Maps each unit to the default way of formatting that unit. This uses full month and weekday names; abbreviated output replaces these with the short forms later. | (def ^:private default-date-formats-for-unit
;; TODO Do we have (in i18n or utils) helpers for getting localized ordinals?
{:year [:year] ; 2022
:quarter ["Q" :quarter " - " :year] ; Q4 - 2022
:minute-of-hour [:minute-d] ; 6, 24
:day-of-week [:day-of-week-full] ; Monday; Mon
:day-of-month [:day-of-month-d] ; 7, 23
:day-of-year [:day-of-year] ; 1, 24, 365
:week-of-year [:week-of-year] ; CLJS: 1st, 42nd; CLJ: 1, 42 (no ordinals)
:month-of-year [:month-full] ; October; Oct
:quarter-of-year ["Q" :quarter]}) ; Q4 |
Map of | (def ^:private date-style-to-format-overrides
(let [m-y [:month-d "/" :year]
mmm-y [:month-full ", " :year]]
{"M/D/YYYY" {:month m-y}
"D/M/YYYY" {:month m-y}
"YYYY/M/D" {:month [:year "/" :month-d]
:quarter [:year " - Q" :quarter]}
"MMMM D, YYYY" {:month mmm-y}
"D MMMM, YYYY" {:month mmm-y}
"dddd, MMMM D, YYYY" {:week [:month-full " " :day-of-month-d ", " :year]
:month mmm-y}})) |
(def ^:private fallback-iso-format [:year "-" :month-dd "-" :day-of-month-dd "T" :hour-24-dd ":" :minute-dd ":" :second-dd]) | |
The | (defn- resolve-date-style
[{:keys [date-format date-style unit]}]
(or date-format
(get-in date-style-to-format-overrides [date-style unit])
(get default-date-formats-for-unit unit)
(get constants/known-date-styles date-style)
(do
(log/warn "Unrecognized date style" {:date-style date-style
:unit unit})
fallback-iso-format))) |
(defn- normalize-date-format [{:keys [date-format] :as options}]
(merge options (get constants/known-datetime-styles date-format))) | |
(defn- prepend-weekday [date-format] (concat [:day-of-week-short ", "] date-format)) | |
Derives a date format data structure from an options map. There are three possible sources of the final date format:
1. A directly provided A string | (defn- date-format-for-options
[{:keys [date-separator weekday-enabled] :as options}]
(let [date-format (-> options normalize-date-format resolve-date-style)]
(cond-> date-format
date-separator (apply-date-separator date-separator)
weekday-enabled prepend-weekday
(constants/abbreviated? options) apply-date-abbreviation))) |
------------------------------------------ Standardized Formats ------------------------------------------------ | (def ^:private short-month-day (builder/->formatter [:month-short " " :day-of-month-d])) (def ^:private full-month-day (builder/->formatter [:month-full " " :day-of-month-d])) |
(def ^:private short-month-day-year (builder/->formatter [:month-short " " :day-of-month-d ", " :year])) (def ^:private full-month-day-year (builder/->formatter [:month-full " " :day-of-month-d ", " :year])) | |
(defn- short-months? [{:keys [type] :as options}]
(and (constants/abbreviated? options) (not= type "tooltip"))) | |
Helper that gets the right month-day-year format based on the options: either full | (defn month-day-year
[options]
(if (short-months? options)
short-month-day-year
full-month-day-year)) |
Helper that gets the right month-day format based on the options: either full | (defn month-day
[options]
(if (short-months? options)
short-month-day
full-month-day)) |
(def ^:private big-endian-day-format [:year "-" :month-dd "-" :day-of-month-dd]) | |
A cached, commonly used formatter for dates in | (def big-endian-day (builder/->formatter big-endian-day-format)) |
A cached, commonly used formatter for times in 12-hour | (def hour-only (builder/->formatter [:hour-12-d " " :am-pm])) |
A cached, commonly used formatter for full weekday names. | (def weekday (builder/->formatter [:day-of-week-full])) |
--------------------------------------------- Time formatters ---------------------------------------------------- | (defn- english-time-seconds [inner]
(vec (concat [:hour-12-d ":" :minute-dd ":" :second-dd]
inner
[" " :am-pm]))) |
(def ^:private iso-time-seconds [:hour-24-dd ":" :minute-dd ":" :second-dd]) | |
(def ^:private time-style-to-format
{"h:mm A" {nil (english-time-seconds [])
"seconds" (english-time-seconds [])
"milliseconds" (english-time-seconds ["." :millisecond-ddd])}
"HH:mm" {nil iso-time-seconds
"seconds" iso-time-seconds
"milliseconds" (into iso-time-seconds ["." :millisecond-ddd])}}) | |
(def ^:private fallback-iso-time [:hour-24-dd ":" :minute-dd ":" :second-dd]) | |
The time format is resolved as follows:
1. If a | (defn- time-format-for-options
[{:keys [time-enabled time-format time-style] :as options}]
(or (and (string? time-format)
(or (get constants/known-time-styles time-format)
(throw (ex-info "Unknown time format" options))))
time-format
(get-in time-style-to-format [time-style time-enabled])
(get constants/known-time-styles time-style)
(do
(log/warn "Unrecognized time style" {:time-style time-style
:time-enabled time-enabled})
fallback-iso-time))) |
------------------------------------- Custom formatters from options --------------------------------------------- These are cached, since the formatter is always identical for the same options. | |
(defn- options->formatter*
[{:keys [date-enabled time-enabled] :as options}]
;; TODO The original emits a console warning if the date-style is not in the overrides map. Reproduce that?
(let [date-format (when date-enabled (date-format-for-options options))
time-format (when time-enabled (time-format-for-options options))
format-list (if (and date-format time-format)
(concat date-format [", "] time-format)
;; At most one format is given; use that one.
;; If neither is set, emit a warning and use ISO standard format.
(or date-format
time-format
(do
(log/warn "Unrecognized date/time format" options)
fallback-iso-format)))]
(builder/->formatter format-list))) | |
(def ^:private options->formatter-cache (atom {})) | |
Given the options map, this reduces it to a formatter function.
Expects The options and corresponding formatters are cached indefinitely, since there are generally only a few dozen different sets of options, and from hundreds to many thousands of dates will be formatted in a typical session. | (defn options->formatter
[options]
{:pre [(map? options)]} ;; options must be a Clojure map from date-options/prepare-options
(if-let [fmt (get @options->formatter-cache options)]
fmt
(-> (swap! options->formatter-cache
(fn [cache]
(if (contains? cache options)
cache
(assoc cache options (options->formatter* options)))))
(get options)))) |
Normalization and helper predicates for date formatting options maps. | (ns metabase.shared.formatting.internal.date-options (:require [metabase.shared.formatting.constants :as constants] [metabase.util :as u])) |
(def ^:private default-options
{:date-enabled true
:date-style constants/default-date-style
:time-style constants/default-time-style
:output-density "default"
:unit :default}) | |
(def ^:private units-with-hour
#{:default :minute :hour :hour-of-day}) | |
(def ^:private units-with-day
#{nil :default :minute :hour :day :week}) | |
(def ^:private time-only?
#{:hour-of-day}) | |
Normalizes the options map. This returns a Clojure map with Mixes in the [[default-options]], plus:
- defaulting | (defn prepare-options
[options]
(let [options (-> (u/normalize-map options)
(update :unit keyword))
{:keys [compact date-abbreviate
type unit]
:as options} (merge default-options
(when (units-with-hour (:unit options))
{:time-enabled "minutes"})
options)]
(cond-> options
true (dissoc :compact :date-abbreviate)
(time-only? unit) (assoc :date-enabled false)
(= type "tooltip") (assoc :output-density "condensed")
(or compact date-abbreviate) (assoc :output-density "compact")
(not (units-with-day unit)) (dissoc :weekday-enabled)))) |
JVM Clojure implementation of the [[core/NumberFormatter]] abstaction. | (ns metabase.shared.formatting.internal.numbers (:require [clojure.string :as str] [metabase.shared.formatting.internal.numbers-core :as core] [metabase.shared.util.currency :as currency]) (:import (java.math BigDecimal MathContext RoundingMode) (java.text DecimalFormat NumberFormat) (java.util Currency Locale))) |
(set! *warn-on-reflection* true) | |
Clojure helpers ================================================================================================ | (defn- sig-figs [number figures] (BigDecimal. (double number) (MathContext. figures RoundingMode/HALF_UP))) |
(defn- str-run [n x] (apply str (repeat n x))) | |
(defn- attach-currency-symbol [text ^NumberFormat nf ^Locale locale currency]
(str (currency/currency-symbol currency)
(subs text (count (.getSymbol (.getCurrency nf) locale))))) | |
(defn- symbol-for [currency locale]
(case currency
:BTC "₿"
(-> (name currency)
(Currency/getInstance)
(.getSymbol locale)))) | |
(defn- apply-currency-style [text ^Currency _currency ^Locale locale style currency-key]
(let [sym (symbol-for currency-key locale)
;; TODO Our currency table has plurals but no translation; Java's `Currency.getDisplayName` is singular but
;; translated. We should get the names in currency/currency keyed by locale.
currency (get currency/currency currency-key)]
(case (or style "symbol")
"symbol" (str/replace text sym (:symbol currency)) ; Java's symbols are not identical to ours
"name" (str (str/replace text sym ) " " (:name_plural currency))
"code" (str/replace text sym (str (:code currency) core/non-breaking-space))))) | |
Currencies known not to be supported by the Java [[Currency]] classes. Rendered as USD, then the symbols are replaced. Core internals ================================================================================================= | (def ^:private bad-currencies
#{:BTC}) |
(defn- active-locale [options]
(if (:locale options)
(Locale. (:locale options))
(Locale/getDefault))) | |
(defn- number-formatter-for-options-baseline
^NumberFormat [{:keys [maximum-fraction-digits minimum-fraction-digits number-style]} locale]
(let [^NumberFormat nf (case number-style
;; For scientific, assemble the 0.###E0 DecimalFormat pattern.
"scientific" (DecimalFormat. (str "0."
(str-run (or minimum-fraction-digits 0) "0")
(str-run (- (or maximum-fraction-digits 2)
(or minimum-fraction-digits 0))
"#")
"E0"))
"currency" (NumberFormat/getCurrencyInstance locale)
"percent" (NumberFormat/getPercentInstance locale)
(NumberFormat/getInstance locale))]
(when (not (= number-style #"scientific"))
(.setMaximumFractionDigits nf (or maximum-fraction-digits 300)))
nf)) | |
(defn- set-rounding! [^NumberFormat nf] ;; JavaScript does not support picking the rounding mode; it's always HALF_UP. ;; (Intl.NumberFormat has an option `roundingMode` but it's new and not supported anywhere as of EOY2022.) ;; Since Java is flexible, we match the HALF_UP behavior here. (.setRoundingMode nf RoundingMode/HALF_UP)) | |
(defn- set-minimum-fraction! [^NumberFormat nf options]
(when (:minimum-fraction-digits options)
(.setMinimumFractionDigits nf (:minimum-fraction-digits options)))) | |
(defn- set-currency! [^NumberFormat nf currency]
(when currency
(.setCurrency nf (if (bad-currencies currency)
;; For the currencies the JVM doesn't support, we use USD and replace the symbols later.
(Currency/getInstance "USD")
(Currency/getInstance (name currency)))))) | |
(defn- set-separators! [^NumberFormat nf options]
(when-let [[decimal grouping] (:number-separators options)]
(let [^DecimalFormat df nf
syms (.getDecimalFormatSymbols df)]
(when decimal
(.setDecimalSeparator syms decimal))
(if grouping
(.setGroupingSeparator syms grouping)
(.setGroupingUsed df false))
(.setDecimalFormatSymbols df syms)))) | |
(defn- prepare-number-formatter! [^NumberFormat nf options currency] (set-rounding! nf) (set-minimum-fraction! nf options) (set-currency! nf currency) (set-separators! nf options)) | |
Certain options do not map into Java's [[NumberFormat]] classes. They are handled by preprocessing the number (eg. by rounding) instead. | (defn- preformat-step
[options]
(if (:maximum-significant-digits options)
#(sig-figs % (:maximum-significant-digits options))
identity)) |
The key function implemented for each language, and called by the top-level number formatting. Returns a [[core/NumberFormatter]] instance for each set of options. These formatters are reusable, but this does no caching. | (defn number-formatter-for-options
[options]
(let [currency (some-> options :currency keyword)
locale (active-locale options)
currency-sym (some-> currency (symbol-for locale))
nf (number-formatter-for-options-baseline options locale)
pre (preformat-step options)]
(prepare-number-formatter! nf options currency)
(reify
core/NumberFormatter
(format-number-basic [_ number]
(cond-> (.format nf (pre (bigdec (double number))))
;; If running a "bad" currency Java doesn't support, replace the default symbol with the real one.
(and currency (bad-currencies currency))
(attach-currency-symbol nf locale currency)
;; Handle the :currency-style option, which isn't supported natively on Java.
currency
(apply-currency-style (.getCurrency nf) locale (:currency-style options) currency)))
(wrap-currency [_ text]
(str currency-sym text))
(split-exponent [_ formatted]
(let [^DecimalFormat df nf ;; Scientific mode always uses the DecimalFormat subclass.
sep (.. df getDecimalFormatSymbols getExponentSeparator)
exp (str/last-index-of formatted sep)]
{:mantissa (subs formatted 0 exp)
:exponent (subs formatted (+ exp (count sep)))}))))) |
Formats a number in scientific notation. The wrangling required differs by platform. Scientific notation ============================================================================================ | (defn format-number-scientific
[number options]
(let [nf (-> options core/prep-options number-formatter-for-options)
base (core/format-number-basic nf number)
{:keys [mantissa exponent]} (core/split-exponent nf base)
?plus (when-not (str/starts-with? exponent "-") "+")]
(str mantissa "e" ?plus exponent))) |
ClojureScript implementation of number formatting. Implements the [[NumberFormatter]] protocol from numbers_core, plus some helpers. | (ns metabase.shared.formatting.internal.numbers (:require [clojure.string :as str] [metabase.shared.formatting.internal.numbers-core :as core] [metabase.shared.util.currency :as currency] [metabase.util :as u])) |
(def ^:private default-number-separators ".,") | |
(defn- adjust-number-separators [text separators]
(if (and separators
(not= separators default-number-separators))
(let [decimal (first separators)
grouping (or (second separators) ) ; grouping separators are optional
transform {"," grouping "." decimal}]
(str/replace text #"[\.,]" transform))
text)) | |
(defn- fix-currency-symbols [text currency]
(let [sym (currency/currency-symbol currency)]
(-> text
;; Some have spaces and some don't - remove the space if it's there.
(str/replace (str (name currency) core/non-breaking-space) sym)
(str/replace (name currency) sym)))) | |
(defn- base-format-scientific [nf number]
(letfn [(transform [{:keys [type value]}]
(case type
"exponentSeparator" "e"
value))]
(let [parts (js->clj (.formatToParts nf number) {:keywordize-keys true})
;; If there's no exponent minus sign, add a plus sign.
parts (if (some #(= (:type %) "exponentMinusSign") parts)
parts
(let [[pre post] (split-with #(not= (:type %) "exponentInteger") parts)]
(concat pre [{:type "exponentPlusSign" :value "+"}] post)))]
(apply str (map transform parts))))) | |
Core internals ================================================================================================= TODO(braden) We could get more nicely localized currency values by using the user's locale. The problem is that then we don't know what the number separators are. We could determine it with a simple test like formatting 12345.67, though. Using "en" here means, among other things, that currency values are not localized as well as they could be. Many European languages put currency signs as suffixes, eg. 123 euros is: - "€123.00" in "en" - "€123,00" with "en" but fixing up the separators for a German locale - "123,00 €" in actual German convention, which is what we would get with a native "de" locale here. | (defn- number-formatter-for-options-baseline [options]
(let [default-fraction-digits (when (= (:number-style options) "currency")
2)]
(js/Intl.NumberFormat.
"en"
(clj->js (u/remove-nils
{:style (when-not (= (:number-style options) "scientific")
(:number-style options "decimal"))
:notation (when (= (:number-style options) "scientific")
"scientific")
:currency (:currency options)
:currencyDisplay (:currency-style options)
;; Always use grouping separators, but we may remove them per number_separators.
:useGrouping true
:minimumIntegerDigits (:minimum-integer-digits options)
:minimumFractionDigits (:minimum-fraction-digits options default-fraction-digits)
:maximumFractionDigits (:maximum-fraction-digits options default-fraction-digits)
:minimumSignificantDigits (:minimum-significant-digits options)
:maximumSignificantDigits (:maximum-significant-digits options)}))))) |
(defn- currency-symbols? [options]
(let [style (:currency-style options)]
(and (:currency options)
(or (nil? style)
(= style "symbol"))))) | |
(defn- formatter-fn [nf options]
(case (:number-style options)
"scientific" #(base-format-scientific nf %)
#(.format nf %))) | |
The key function implemented for each language, and called by the top-level number formatting. Returns a [[core/NumberFormatter]] instance for each set of options. These formatters are reusable, but this does no caching. | (defn number-formatter-for-options
[options]
(let [nf (number-formatter-for-options-baseline options)
symbols? (currency-symbols? options)
formatter (formatter-fn nf options)]
(reify
core/NumberFormatter
(format-number-basic [_ number]
(cond-> (formatter number)
true (adjust-number-separators (:number-separators options))
symbols? (fix-currency-symbols (:currency options))))
(wrap-currency [_ text]
;; Intl.NumberFormat.formatToParts(1) returns, eg. [currency, integer, decimal, fraction]
;; Keep only currency and integer, and replace integer's :value with our provided text.
(apply str (for [{:keys [type value]} (js->clj (.formatToParts nf 1) :keywordize-keys true)
:when (#{"currency" "integer"} type)]
(if (= type "integer")
text
value))))
(split-exponent [_ formatted] (throw (ex-info "split-exponent not implemented" {:text formatted})))))) |
Formats a number in scientific notation. The wrangling required differs by platform. Scientific notation ============================================================================================ | (defn format-number-scientific
[number options]
(-> (core/prep-options options)
number-formatter-for-options
(core/format-number-basic number))) |
Cross-platform foundation for the number formatters. | (ns metabase.shared.formatting.internal.numbers-core (:require [metabase.shared.util.currency :as currency])) |
Options ======================================================================================================== | (defn- default-decimal-places [{:keys [currency number-style]}]
(if (and currency (= number-style "currency"))
(let [places (-> currency keyword (@currency/currency-map) :decimal_digits)]
{:minimum-fraction-digits places
:maximum-fraction-digits places})
{:maximum-fraction-digits 2})) |
Transforms input options with defaults and other adjustments.
Defaults:
- Adjustments: - :decimals is dropped, and both min and max fraction-digits are set to that value. | (defn prep-options
[options]
(letfn [(expand-decimals [opts]
(-> opts
(dissoc :decimals)
(assoc :maximum-fraction-digits (:decimals options)
:minimum-fraction-digits (:decimals options))))]
(cond-> (merge (default-decimal-places options) options)
(:decimals options) expand-decimals))) |
A Unicode non-breaking space character. | (def non-breaking-space \u00a0) |
Formatter abstraction ========================================================================================== | (defprotocol NumberFormatter
(format-number-basic [this number] "Returns a String that represents the number in this format.")
(split-exponent [this formatted]
"Given a scientific notation string, split it at the locale-dependent exponent.
Returns a map `{:mantissa \"123\" :exponent \"+4\"}`.")
(wrap-currency [this text] "Given an opaque string, wraps it with the currency prefix/suffix for this locale.")) |
(ns metabase.shared.formatting.numbers (:require [metabase.shared.formatting.internal.numbers :as internal] [metabase.shared.formatting.internal.numbers-core :as core] [metabase.util :as u])) | |
(declare format-number) | |
Extra defaults that are mixed in when formatted a currency value in compact mode. | (def compact-currency-options
{:currency-style "symbol"}) |
#?(:cljs
(def ^:export compact-currency-options-js
"Extra defaults that are mixed in when formatted a currency value in compact mode."
(clj->js compact-currency-options)))
;; Compact form ===================================================================================================
(def ^:private display-compact-decimals-cutoff 1000) | |
(def ^:private humanized-powers [[1000000000000 "T"] [1000000000 "B"] [1000000 "M"] [1000 "k"]]) | |
(defn- format-number-compact-basic [number options]
(let [options (dissoc options :compact :number-style)
abs-value (abs number)]
(cond
(zero? number) "0"
(< abs-value display-compact-decimals-cutoff) (format-number number options)
:else (let [[power suffix] (first (filter #(>= abs-value (first %)) humanized-powers))]
(str (format-number (/ number power)
(merge options {:minimum-fraction-digits 1 :maximum-fraction-digits 1}))
suffix))))) | |
(defmulti ^:private format-number-compact* (fn [_ {:keys [number-style]}] number-style)) | |
(defmethod format-number-compact* :default [number options] (format-number-compact-basic number options)) | |
(defmethod format-number-compact* "percent" [number options] (str (format-number-compact-basic (* 100 number) options) "%")) | |
(defmethod format-number-compact* "currency" [number options]
(let [options (merge options compact-currency-options)
formatter (internal/number-formatter-for-options options)]
(if (< (abs number) display-compact-decimals-cutoff)
(core/format-number-basic formatter number)
(core/wrap-currency formatter (format-number-compact-basic number options))))) | |
(defmethod format-number-compact* "scientific" [number options]
(internal/format-number-scientific number (merge options {:maximum-fraction-digits 1 :minimum-fraction-digits 1}))) | |
(defn- format-number-compact [number options]
(format-number-compact* number (-> options
(dissoc :compact)
core/prep-options))) | |
High-level ===================================================================================================== | (defn- format-number-standard [number options]
(let [options (core/prep-options options)
nf (cond
(:number-formatter options) (:number-formatter options)
;; Hacky special case inherited from the TS version - to match classic behavior for small numbers,
;; treat maximum-fraction-digits as maximum-significant-digits instead.
;; "Small" means |x| < 1, or < 1% for percentages.
(and (not (:decimals options))
(not (:minimum-fraction-digits options))
(not= (:number-style options) "currency")
(< (abs number)
(if (= (:number-style options) "percent")
0.01
1)))
(-> options
(dissoc :maximum-fraction-digits)
(assoc :maximum-significant-digits (max 2 (:minimum-significant-digits options 0)))
internal/number-formatter-for-options)
:else (internal/number-formatter-for-options options))]
(core/format-number-basic nf number))) |
Formats a number according to a map of options.
The options:
- | (defn ^:export format-number
[number options]
(let [{:keys [compact negative-in-parentheses number-style scale] :as options} (u/normalize-map options)]
(cond
(and scale (not (NaN? scale))) (format-number (* scale number) (dissoc options :scale))
(and (neg? number)
negative-in-parentheses) (str "("
(format-number (- number) (assoc options :negative-in-parentheses false))
")")
compact (format-number-compact number options)
(= (keyword number-style)
:scientific) (internal/format-number-scientific number options)
:else (format-number-standard number options)))) |
The list of currencies, and associated metadata, used by Metabase for number formatting. | (ns metabase.shared.util.currency) |
Currencies for which the Metabase frontend supports formatting with its symbol, rather than just its code or name. This list is referenced during XLSX export to achieve parity in currency formatting. | (defn supports-symbol?
[currency-code]
(contains?
#{:USD ;; US dollar
:CAD ;; Canadian dollar
:EUR ;; Euro
:AUD ;; Australian dollar
:BRL ;; Brazilian real
:CNY ;; Chinese yuan
:GBP ;; British pound
:HKD ;; Hong Kong dollar
:ILS ;; Israeli new shekel
:INR ;; Indian rupee
:JPY ;; Japanese yen
:KRW ;; South Korean won
:MXN ;; Mexican peso
:NZD ;; New Zealand dollar
:TWD ;; New Taiwan dollar
:VND} ;; Vietnamese dong
(keyword currency-code))) |
(def ^:private currency-list
[[:USD {:symbol "$",
:name "US Dollar",
:symbol_native "$",
:decimal_digits 2,
:rounding 0,
:code "USD",
:name_plural "US dollars"}],
[:CAD {:symbol "CA$",
:name "Canadian Dollar",
:symbol_native "$",
:decimal_digits 2,
:rounding 0,
:code "CAD",
:name_plural "Canadian dollars"}],
[:EUR {:symbol "€",
:name "Euro",
:symbol_native "€",
:decimal_digits 2,
:rounding 0,
:code "EUR",
:name_plural "euros"}],
[:AED {:symbol "AED",
:name "United Arab Emirates Dirham",
:symbol_native "د.إ.",
:decimal_digits 2,
:rounding 0,
:code "AED",
:name_plural "UAE dirhams"}],
[:AFN {:symbol "Af",
:name "Afghan Afghani",
:symbol_native "؋",
:decimal_digits 0,
:rounding 0,
:code "AFN",
:name_plural "Afghan Afghanis"}],
[:ALL {:symbol "ALL",
:name "Albanian Lek",
:symbol_native "Lek",
:decimal_digits 0,
:rounding 0,
:code "ALL",
:name_plural "Albanian lekë"}],
[:AMD {:symbol "AMD",
:name "Armenian Dram",
:symbol_native "դր.",
:decimal_digits 0,
:rounding 0,
:code "AMD",
:name_plural "Armenian drams"}],
[:ARS {:symbol "AR$",
:name "Argentine Peso",
:symbol_native "$",
:decimal_digits 2,
:rounding 0,
:code "ARS",
:name_plural "Argentine pesos"}],
[:AUD {:symbol "AU$",
:name "Australian Dollar",
:symbol_native "$",
:decimal_digits 2,
:rounding 0,
:code "AUD",
:name_plural "Australian dollars"}],
[:AZN {:symbol "₼",
:name "Azerbaijani Manat",
:symbol_native "₼",
:decimal_digits 2,
:rounding 0,
:code "AZN",
:name_plural "Azerbaijani manats"}],
[:BAM {:symbol "KM",
:name "Bosnia-Herzegovina Convertible Mark",
:symbol_native "KM",
:decimal_digits 2,
:rounding 0,
:code "BAM",
:name_plural "Bosnia-Herzegovina convertible marks"}],
[:BDT {:symbol "Tk",
:name "Bangladeshi Taka",
:symbol_native "৳",
:decimal_digits 2,
:rounding 0,
:code "BDT",
:name_plural "Bangladeshi takas"}],
[:BGN {:symbol "BGN",
:name "Bulgarian Lev",
:symbol_native "лв.",
:decimal_digits 2,
:rounding 0,
:code "BGN",
:name_plural "Bulgarian leva"}],
[:BHD {:symbol "BD",
:name "Bahraini Dinar",
:symbol_native "د.ب.",
:decimal_digits 3,
:rounding 0,
:code "BHD",
:name_plural "Bahraini dinars"}],
[:BIF {:symbol "FBu",
:name "Burundian Franc",
:symbol_native "FBu",
:decimal_digits 0,
:rounding 0,
:code "BIF",
:name_plural "Burundian francs"}],
[:BND {:symbol "BN$",
:name "Brunei Dollar",
:symbol_native "$",
:decimal_digits 2,
:rounding 0,
:code "BND",
:name_plural "Brunei dollars"}],
[:BOB {:symbol "Bs",
:name "Bolivian Boliviano",
:symbol_native "Bs",
:decimal_digits 2,
:rounding 0,
:code "BOB",
:name_plural "Bolivian bolivianos"}],
[:BRL {:symbol "R$",
:name "Brazilian Real",
:symbol_native "R$",
:decimal_digits 2,
:rounding 0,
:code "BRL",
:name_plural "Brazilian reals"}],
[:BTC {:symbol "₿",
:name "Bitcoin",
:symbol_native "BTC",
:decimal_digits 8,
:rounding 0,
:code "BTC",
:name_plural "Bitcoins"}],
[:BWP {:symbol "BWP",
:name "Botswanan Pula",
:symbol_native "P",
:decimal_digits 2,
:rounding 0,
:code "BWP",
:name_plural "Botswanan pulas"}],
[:BYR {:symbol "BYR",
:name "Belarusian Ruble",
:symbol_native "BYR",
:decimal_digits 0,
:rounding 0,
:code "BYR",
:name_plural "Belarusian rubles"}],
[:BZD {:symbol "BZ$",
:name "Belize Dollar",
:symbol_native "$",
:decimal_digits 2,
:rounding 0,
:code "BZD",
:name_plural "Belize dollars"}],
[:CDF {:symbol "CDF",
:name "Congolese Franc",
:symbol_native "FrCD",
:decimal_digits 2,
:rounding 0,
:code "CDF",
:name_plural "Congolese francs"}],
[:CHF {:symbol "CHF",
:name "Swiss Franc",
:symbol_native "CHF",
:decimal_digits 2,
:rounding 0.05,
:code "CHF",
:name_plural "Swiss francs"}],
[:CLP {:symbol "CL$",
:name "Chilean Peso",
:symbol_native "$",
:decimal_digits 0,
:rounding 0,
:code "CLP",
:name_plural "Chilean pesos"}],
[:CNY {:symbol "CN¥",
:name "Chinese Yuan",
:symbol_native "CN¥",
:decimal_digits 2,
:rounding 0,
:code "CNY",
:name_plural "Chinese yuan"}],
[:COP {:symbol "CO$",
:name "Colombian Peso",
:symbol_native "$",
:decimal_digits 0,
:rounding 0,
:code "COP",
:name_plural "Colombian pesos"}],
[:CRC {:symbol "₡",
:name "Costa Rican Colón",
:symbol_native "₡",
:decimal_digits 0,
:rounding 0,
:code "CRC",
:name_plural "Costa Rican colóns"}],
[:CVE {:symbol "CV$",
:name "Cape Verdean Escudo",
:symbol_native "CV$",
:decimal_digits 2,
:rounding 0,
:code "CVE",
:name_plural "Cape Verdean escudos"}],
[:CZK {:symbol "Kč",
:name "Czech Republic Koruna",
:symbol_native "Kč",
:decimal_digits 2,
:rounding 0,
:code "CZK",
:name_plural "Czech Republic korunas"}],
[:DJF {:symbol "Fdj",
:name "Djiboutian Franc",
:symbol_native "Fdj",
:decimal_digits 0,
:rounding 0,
:code "DJF",
:name_plural "Djiboutian francs"}],
[:DKK {:symbol "Dkr",
:name "Danish Krone",
:symbol_native "kr",
:decimal_digits 2,
:rounding 0,
:code "DKK",
:name_plural "Danish kroner"}],
[:DOP {:symbol "RD$",
:name "Dominican Peso",
:symbol_native "RD$",
:decimal_digits 2,
:rounding 0,
:code "DOP",
:name_plural "Dominican pesos"}],
[:DZD {:symbol "DA",
:name "Algerian Dinar",
:symbol_native "د.ج.",
:decimal_digits 2,
:rounding 0,
:code "DZD",
:name_plural "Algerian dinars"}],
[:EGP {:symbol "EGP",
:name "Egyptian Pound",
:symbol_native "ج.م.",
:decimal_digits 2,
:rounding 0,
:code "EGP",
:name_plural "Egyptian pounds"}],
[:ERN {:symbol "Nfk",
:name "Eritrean Nakfa",
:symbol_native "Nfk",
:decimal_digits 2,
:rounding 0,
:code "ERN",
:name_plural "Eritrean nakfas"}],
[:ETB {:symbol "Br",
:name "Ethiopian Birr",
:symbol_native "Br",
:decimal_digits 2,
:rounding 0,
:code "ETB",
:name_plural "Ethiopian birrs"}],
[:ETH {:symbol "ETH",
:name "Ethereum",
:symbol_native "ETH",
:decimal_digits 8,
:rounding 0,
:code "ETH",
:name_plural "Ethereum"}],
[:GBP {:symbol "£",
:name "British Pound Sterling",
:symbol_native "£",
:decimal_digits 2,
:rounding 0,
:code "GBP",
:name_plural "British pounds sterling"}],
[:GEL {:symbol "GEL",
:name "Georgian Lari",
:symbol_native "GEL",
:decimal_digits 2,
:rounding 0,
:code "GEL",
:name_plural "Georgian laris"}],
[:GHS {:symbol "GH₵",
:name "Ghanaian Cedi",
:symbol_native "GH₵",
:decimal_digits 2,
:rounding 0,
:code "GHS",
:name_plural "Ghanaian cedis"}],
[:GNF {:symbol "FG",
:name "Guinean Franc",
:symbol_native "FG",
:decimal_digits 0,
:rounding 0,
:code "GNF",
:name_plural "Guinean francs"}],
[:GTQ {:symbol "GTQ",
:name "Guatemalan Quetzal",
:symbol_native "Q",
:decimal_digits 2,
:rounding 0,
:code "GTQ",
:name_plural "Guatemalan quetzals"}],
[:HKD {:symbol "HK$",
:name "Hong Kong Dollar",
:symbol_native "$",
:decimal_digits 2,
:rounding 0,
:code "HKD",
:name_plural "Hong Kong dollars"}],
[:HNL {:symbol "HNL",
:name "Honduran Lempira",
:symbol_native "L",
:decimal_digits 2,
:rounding 0,
:code "HNL",
:name_plural "Honduran lempiras"}],
[:HRK {:symbol "kn",
:name "Croatian Kuna",
:symbol_native "kn",
:decimal_digits 2,
:rounding 0,
:code "HRK",
:name_plural "Croatian kunas"}],
[:HUF {:symbol "Ft",
:name "Hungarian Forint",
:symbol_native "Ft",
:decimal_digits 0,
:rounding 0,
:code "HUF",
:name_plural "Hungarian forints"}],
[:IDR {:symbol "Rp",
:name "Indonesian Rupiah",
:symbol_native "Rp",
:decimal_digits 0,
:rounding 0,
:code "IDR",
:name_plural "Indonesian rupiahs"}],
[:ILS {:symbol "₪",
:name "Israeli New Shekel",
:symbol_native "₪",
:decimal_digits 2,
:rounding 0,
:code "ILS",
:name_plural "Israeli new shekels"}],
[:INR {:symbol "Rs",
:name "Indian Rupee",
:symbol_native "টকা",
:decimal_digits 2,
:rounding 0,
:code "INR",
:name_plural "Indian rupees"}],
[:IQD {:symbol "IQD",
:name "Iraqi Dinar",
:symbol_native "د.ع.",
:decimal_digits 0,
:rounding 0,
:code "IQD",
:name_plural "Iraqi dinars"}],
[:IRR {:symbol "IRR",
:name "Iranian Rial",
:symbol_native "﷼",
:decimal_digits 0,
:rounding 0,
:code "IRR",
:name_plural "Iranian rials"}],
[:ISK {:symbol "Ikr",
:name "Icelandic Króna",
:symbol_native "kr",
:decimal_digits 0,
:rounding 0,
:code "ISK",
:name_plural "Icelandic krónur"}],
[:JMD {:symbol "J$",
:name "Jamaican Dollar",
:symbol_native "$",
:decimal_digits 2,
:rounding 0,
:code "JMD",
:name_plural "Jamaican dollars"}],
[:JOD {:symbol "JD",
:name "Jordanian Dinar",
:symbol_native "د.أ.",
:decimal_digits 3,
:rounding 0,
:code "JOD",
:name_plural "Jordanian dinars"}],
[:JPY {:symbol "¥",
:name "Japanese Yen",
:symbol_native "¥",
:decimal_digits 0,
:rounding 0,
:code "JPY",
:name_plural "Japanese yen"}],
[:KES {:symbol "Ksh",
:name "Kenyan Shilling",
:symbol_native "Ksh",
:decimal_digits 2,
:rounding 0,
:code "KES",
:name_plural "Kenyan shillings"}],
[:KGS {:symbol "KGS",
:name "Kyrgyz Som",
:symbol_native "сом",
:decimal_digits 2,
:rounding 0,
:code "KGS",
:name_plural "Kyrgyz soms"}],
[:KHR {:symbol "KHR",
:name "Cambodian Riel",
:symbol_native "៛",
:decimal_digits 2,
:rounding 0,
:code "KHR",
:name_plural "Cambodian riels"}],
[:KMF {:symbol "CF",
:name "Comorian Franc",
:symbol_native "FC",
:decimal_digits 0,
:rounding 0,
:code "KMF",
:name_plural "Comorian francs"}],
[:KRW {:symbol "₩",
:name "South Korean Won",
:symbol_native "₩",
:decimal_digits 0,
:rounding 0,
:code "KRW",
:name_plural "South Korean won"}],
[:KWD {:symbol "KD",
:name "Kuwaiti Dinar",
:symbol_native "د.ك.",
:decimal_digits 3,
:rounding 0,
:code "KWD",
:name_plural "Kuwaiti dinars"}],
[:KZT {:symbol "KZT",
:name "Kazakhstani Tenge",
:symbol_native "тңг.",
:decimal_digits 2,
:rounding 0,
:code "KZT",
:name_plural "Kazakhstani tenges"}],
[:LBP {:symbol "LB£",
:name "Lebanese Pound",
:symbol_native "ل.ل.",
:decimal_digits 0,
:rounding 0,
:code "LBP",
:name_plural "Lebanese pounds"}],
[:LKR {:symbol "SLRs",
:name "Sri Lankan Rupee",
:symbol_native "SL Re",
:decimal_digits 2,
:rounding 0,
:code "LKR",
:name_plural "Sri Lankan rupees"}],
[:LTL {:symbol "Lt",
:name "Lithuanian Litas",
:symbol_native "Lt",
:decimal_digits 2,
:rounding 0,
:code "LTL",
:name_plural "Lithuanian litai"}],
[:LVL {:symbol "Ls",
:name "Latvian Lats",
:symbol_native "Ls",
:decimal_digits 2,
:rounding 0,
:code "LVL",
:name_plural "Latvian lati"}],
[:LYD {:symbol "LD",
:name "Libyan Dinar",
:symbol_native "د.ل.",
:decimal_digits 3,
:rounding 0,
:code "LYD",
:name_plural "Libyan dinars"}],
[:MAD {:symbol "MAD",
:name "Moroccan Dirham",
:symbol_native "د.م.",
:decimal_digits 2,
:rounding 0,
:code "MAD",
:name_plural "Moroccan dirhams"}],
[:MDL {:symbol "MDL",
:name "Moldovan Leu",
:symbol_native "MDL",
:decimal_digits 2,
:rounding 0,
:code "MDL",
:name_plural "Moldovan lei"}],
[:MGA {:symbol "MGA",
:name "Malagasy Ariary",
:symbol_native "MGA",
:decimal_digits 0,
:rounding 0,
:code "MGA",
:name_plural "Malagasy Ariaries"}],
[:MKD {:symbol "MKD",
:name "Macedonian Denar",
:symbol_native "MKD",
:decimal_digits 2,
:rounding 0,
:code "MKD",
:name_plural "Macedonian denari"}],
[:MMK {:symbol "MMK",
:name "Myanma Kyat",
:symbol_native "K",
:decimal_digits 0,
:rounding 0,
:code "MMK",
:name_plural "Myanma kyats"}],
[:MOP {:symbol "MOP$",
:name "Macanese Pataca",
:symbol_native "MOP$",
:decimal_digits 2,
:rounding 0,
:code "MOP",
:name_plural "Macanese patacas"}],
[:MRU {:symbol "MRU",
:name "Mauritania Ouguiya",
:symbol_native "MRU",
:decimal_digits 2,
:rounding 0,
:code "MRU",
:name_plural "Mauritania Ouguiyas"}],
[:MUR {:symbol "MURs",
:name "Mauritian Rupee",
:symbol_native "MURs",
:decimal_digits 0,
:rounding 0,
:code "MUR",
:name_plural "Mauritian rupees"}],
[:MXN {:symbol "MX$",
:name "Mexican Peso",
:symbol_native "$",
:decimal_digits 2,
:rounding 0,
:code "MXN",
:name_plural "Mexican pesos"}],
[:MYR {:symbol "RM",
:name "Malaysian Ringgit",
:symbol_native "RM",
:decimal_digits 2,
:rounding 0,
:code "MYR",
:name_plural "Malaysian ringgits"}],
[:MZN {:symbol "MTn",
:name "Mozambican Metical",
:symbol_native "MTn",
:decimal_digits 2,
:rounding 0,
:code "MZN",
:name_plural "Mozambican meticals"}],
[:NAD {:symbol "N$",
:name "Namibian Dollar",
:symbol_native "N$",
:decimal_digits 2,
:rounding 0,
:code "NAD",
:name_plural "Namibian dollars"}],
[:NGN {:symbol "₦",
:name "Nigerian Naira",
:symbol_native "₦",
:decimal_digits 2,
:rounding 0,
:code "NGN",
:name_plural "Nigerian nairas"}],
[:NIO {:symbol "C$",
:name "Nicaraguan Córdoba",
:symbol_native "C$",
:decimal_digits 2,
:rounding 0,
:code "NIO",
:name_plural "Nicaraguan córdobas"}],
[:NOK {:symbol "Nkr",
:name "Norwegian Krone",
:symbol_native "kr",
:decimal_digits 2,
:rounding 0,
:code "NOK",
:name_plural "Norwegian kroner"}],
[:NPR {:symbol "NPRs",
:name "Nepalese Rupee",
:symbol_native "नेरू",
:decimal_digits 2,
:rounding 0,
:code "NPR",
:name_plural "Nepalese rupees"}],
[:NZD {:symbol "NZ$",
:name "New Zealand Dollar",
:symbol_native "$",
:decimal_digits 2,
:rounding 0,
:code "NZD",
:name_plural "New Zealand dollars"}],
[:OMR {:symbol "OMR",
:name "Omani Rial",
:symbol_native "ر.ع.",
:decimal_digits 3,
:rounding 0,
:code "OMR",
:name_plural "Omani rials"}],
[:PAB {:symbol "B/.",
:name "Panamanian Balboa",
:symbol_native "B/.",
:decimal_digits 2,
:rounding 0,
:code "PAB",
:name_plural "Panamanian balboas"}],
[:PEN {:symbol "S/.",
:name "Peruvian Nuevo Sol",
:symbol_native "S/.",
:decimal_digits 2,
:rounding 0,
:code "PEN",
:name_plural "Peruvian nuevos soles"}],
[:PGK {:symbol "K",
:name "Papua New Guinean Kina",
:symbol_native "K",
:decimal_digits 2,
:rounding 0,
:code "PGK",
:name_plural "Papua New Guinean kina"}],
[:PHP {:symbol "₱",
:name "Philippine Peso",
:symbol_native "₱",
:decimal_digits 2,
:rounding 0,
:code "PHP",
:name_plural "Philippine pesos"}],
[:PKR {:symbol "PKRs",
:name "Pakistani Rupee",
:symbol_native "₨",
:decimal_digits 0,
:rounding 0,
:code "PKR",
:name_plural "Pakistani rupees"}],
[:PLN {:symbol "zł",
:name "Polish Zloty",
:symbol_native "zł",
:decimal_digits 2,
:rounding 0,
:code "PLN",
:name_plural "Polish zlotys"}],
[:PYG {:symbol "₲",
:name "Paraguayan Guarani",
:symbol_native "₲",
:decimal_digits 0,
:rounding 0,
:code "PYG",
:name_plural "Paraguayan guaranis"}],
[:QAR {:symbol "QR",
:name "Qatari Rial",
:symbol_native "ر.ق.",
:decimal_digits 2,
:rounding 0,
:code "QAR",
:name_plural "Qatari rials"}],
[:RON {:symbol "RON",
:name "Romanian Leu",
:symbol_native "RON",
:decimal_digits 2,
:rounding 0,
:code "RON",
:name_plural "Romanian lei"}],
[:RSD {:symbol "din.",
:name "Serbian Dinar",
:symbol_native "дин.",
:decimal_digits 0,
:rounding 0,
:code "RSD",
:name_plural "Serbian dinars"}],
[:RUB {:symbol "₽",
:name "Russian Ruble",
:symbol_native "₽",
:decimal_digits 2,
:rounding 0,
:code "RUB",
:name_plural "Russian rubles"}],
[:RWF {:symbol "RWF",
:name "Rwandan Franc",
:symbol_native "FR",
:decimal_digits 0,
:rounding 0,
:code "RWF",
:name_plural "Rwandan francs"}],
[:SAR {:symbol "SR",
:name "Saudi Riyal",
:symbol_native "ر.س.",
:decimal_digits 2,
:rounding 0,
:code "SAR",
:name_plural "Saudi riyals"}],
[:SDG {:symbol "SDG",
:name "Sudanese Pound",
:symbol_native "SDG",
:decimal_digits 2,
:rounding 0,
:code "SDG",
:name_plural "Sudanese pounds"}],
[:SEK {:symbol "Skr",
:name "Swedish Krona",
:symbol_native "kr",
:decimal_digits 2,
:rounding 0,
:code "SEK",
:name_plural "Swedish kronor"}],
[:SGD {:symbol "S$",
:name "Singapore Dollar",
:symbol_native "$",
:decimal_digits 2,
:rounding 0,
:code "SGD",
:name_plural "Singapore dollars"}],
[:SOS {:symbol "Ssh",
:name "Somali Shilling",
:symbol_native "Sh.So",
:decimal_digits 0,
:rounding 0,
:code "SOS",
:name_plural "Somali shillings"}],
[:SYP {:symbol "SY£",
:name "Syrian Pound",
:symbol_native "ل.س.",
:decimal_digits 0,
:rounding 0,
:code "SYP",
:name_plural "Syrian pounds"}],
[:THB {:symbol "฿",
:name "Thai Baht",
:symbol_native "฿",
:decimal_digits 2,
:rounding 0,
:code "THB",
:name_plural "Thai baht"}],
[:TND {:symbol "DT",
:name "Tunisian Dinar",
:symbol_native "د.ت.",
:decimal_digits 3,
:rounding 0,
:code "TND",
:name_plural "Tunisian dinars"}],
[:TOP {:symbol "T$",
:name "Tongan Paʻanga",
:symbol_native "T$",
:decimal_digits 2,
:rounding 0,
:code "TOP",
:name_plural "Tongan paʻanga"}],
[:TRY {:symbol "₺",
:name "Turkish Lira",
:symbol_native "₺",
:decimal_digits 2,
:rounding 0,
:code "TRY",
:name_plural "Turkish Lira"}],
[:TTD {:symbol "TT$",
:name "Trinidad and Tobago Dollar",
:symbol_native "$",
:decimal_digits 2,
:rounding 0,
:code "TTD",
:name_plural "Trinidad and Tobago dollars"}],
[:TWD {:symbol "NT$",
:name "New Taiwan Dollar",
:symbol_native "NT$",
:decimal_digits 0,
:rounding 0,
:code "TWD",
:name_plural "New Taiwan dollars"}],
[:TZS {:symbol "TSh",
:name "Tanzanian Shilling",
:symbol_native "TSh",
:decimal_digits 0,
:rounding 0,
:code "TZS",
:name_plural "Tanzanian shillings"}],
[:UAH {:symbol "₴",
:name "Ukrainian Hryvnia",
:symbol_native "₴",
:decimal_digits 2,
:rounding 0,
:code "UAH",
:name_plural "Ukrainian hryvnias"}],
[:UGX {:symbol "USh",
:name "Ugandan Shilling",
:symbol_native "USh",
:decimal_digits 0,
:rounding 0,
:code "UGX",
:name_plural "Ugandan shillings"}],
[:UYU {:symbol "$U",
:name "Uruguayan Peso",
:symbol_native "$",
:decimal_digits 2,
:rounding 0,
:code "UYU",
:name_plural "Uruguayan pesos"}],
[:UZS {:symbol "UZS",
:name "Uzbekistan Som",
:symbol_native "UZS",
:decimal_digits 0,
:rounding 0,
:code "UZS",
:name_plural "Uzbekistan som"}],
[:VEF {:symbol "Bs.S.",
:name "Venezuelan Bolívar",
:symbol_native "Bs.S.",
:decimal_digits 2,
:rounding 0,
:code "VES",
:name_plural "Venezuelan bolívars"}],
[:VND {:symbol "₫",
:name "Vietnamese Dong",
:symbol_native "₫",
:decimal_digits 0,
:rounding 0,
:code "VND",
:name_plural "Vietnamese dong"}],
[:XAF {:symbol "FCFA",
:name "CFA Franc BEAC",
:symbol_native "FCFA",
:decimal_digits 0,
:rounding 0,
:code "XAF",
:name_plural "CFA francs BEAC"}],
[:XOF {:symbol "CFA",
:name "CFA Franc BCEAO",
:symbol_native "CFA",
:decimal_digits 0,
:rounding 0,
:code "XOF",
:name_plural "CFA francs BCEAO"}],
[:YER {:symbol "YR",
:name "Yemeni Rial",
:symbol_native "ر.ي.",
:decimal_digits 0,
:rounding 0,
:code "YER",
:name_plural "Yemeni rials"}],
[:ZAR {:symbol "R",
:name "South African Rand",
:symbol_native "R",
:decimal_digits 2,
:rounding 0,
:code "ZAR",
:name_plural "South African rand"}],
[:ZMK {:symbol "ZK",
:name "Zambian Kwacha",
:symbol_native "ZK",
:decimal_digits 0,
:rounding 0,
:code "ZMW",
:name_plural "Zambian kwachas"}]]) | |
The currencies as a Clojure map. Wrapped in [[delay]] so it's only computed on demand. | (def currency-map
(delay (into {} currency-list))) |
Given a currency symbol, as a string or keyword, look it up in the currency map and return the symbol for it as a string. | (defn ^:export currency-symbol [currency] (some->> currency keyword (get @currency-map) :symbol)) |
Returns the list of currencies supported by Metabase, with associated metadata. In Clojure, it is converted to a map for quick lookup of currency symbols during XLSX exports. In ClojureScript, it is kept as a 2D array to maintain the order of currencies. | (def ^:export currency
#?(:clj @currency-map
:cljs (clj->js currency-list))) |
(ns metabase.shared.util.i18n (:require ["ttag" :as ttag] [clojure.string :as str]) (:require-macros [metabase.shared.util.i18n])) | |
(comment metabase.shared.util.i18n/keep-me
ttag/keep-me) | |
Converts | (defn- escape-format-string [format-string] (str/replace format-string #"''" "'")) |
Format an i18n The strings are formatted in | (defn js-i18n
[format-string & args]
(let [strings (-> format-string
escape-format-string
(str/split #"\{\d+\}"))]
(apply ttag/t (clj->js strings) (clj->js args)))) |
(def ^:private re-param-zero #"\{0\}") | |
Format an i18n | (defn js-i18n-n
[format-string format-string-pl n]
(let [format-string-esc (escape-format-string format-string)
strings (str/split format-string-esc re-param-zero)
strings (if (= (count strings) 1)
[format-string-esc ""]
strings)
has-n? (re-find #".*\{0\}.*" format-string-esc)]
(ttag/ngettext (ttag/msgid (clj->js strings) (if has-n? n ""))
(-> format-string-pl
escape-format-string
(str/replace re-param-zero (str n)))
n))) |
(ns metabase.shared.util.i18n (:require [metabase.util.i18n :as i18n] [net.cgrand.macrovich :as macros])) | |
i18n a string with the user's locale. Format string will be translated to the user's locale when the form is eval'ed.
Placeholders should use (tru "Number of cans: {0}" 2) | (defmacro tru
[format-string & args]
(macros/case
:clj
`(i18n/tru ~format-string ~@args)
:cljs
`(js-i18n ~format-string ~@args))) |
i18n a string with the site's locale, when called from Clojure. Format string will be translated to the site's
locale when the form is eval'ed. Placeholders should use (trs "Number of cans: {0}" 2) NOTE: When called from ClojureScript, this function behaves identically to | (defmacro trs
[format-string & args]
(macros/case
:clj
(do
(require 'metabase.util.i18n)
`(i18n/trs ~format-string ~@args))
:cljs
`(js-i18n ~format-string ~@args))) |
i18n a string with both singular and plural forms, using the current user's locale. The appropriate plural form will
be returned based on the value of | (defmacro trun
[format-string format-string-pl n]
(macros/case
:clj
`(i18n/trun ~format-string ~format-string-pl ~n)
:cljs
`(js-i18n-n ~format-string ~format-string-pl ~n))) |
i18n a string with both singular and plural forms, using the site's locale. The appropriate plural form will be
returned based on the value of | (defmacro trsn
[format-string format-string-pl n]
(macros/case
:clj
`(i18n/trsn ~format-string ~format-string-pl ~n)
:cljs
`(js-i18n-n ~format-string ~format-string-pl ~n))) |
(ns metabase.shared.util.internal.time (:require [java-time.api :as t] [metabase.public-settings :as public-settings] [metabase.shared.util.internal.time-common :as common] [metabase.util.date-2 :as u.date]) (:import java.util.Locale)) | |
(set! *warn-on-reflection* true) | |
(defn- now [] (t/offset-date-time)) | |
Given any value, check if it's a datetime object. ----------------------------------------------- predicates ------------------------------------------------------- | (defn datetime?
[value]
(or (t/offset-date-time? value)
(t/zoned-date-time? value)
(t/instant? value))) |
checks if the provided value is a local time value. | (defn time? [value] (t/local-time? value)) |
Given a datetime, check that it's valid. | (defn valid?
[value]
(or (datetime? value)
(t/offset-time? value)
(t/local-time? value))) |
Does nothing. Just a placeholder in CLJS; the JVM implementation does some real work. | (defn normalize [value] (t/offset-date-time value)) |
Given two platform-specific datetimes, checks if they fall within the same day. | (defn same-day? [d1 d2] (= (t/truncate-to d1 :days) (t/truncate-to d2 :days))) |
True if these two datetimes fall in the same year. | (defn same-year? [d1 d2] (= (t/year d1) (t/year d2))) |
True if these two datetimes fall in the same (year and) month. | (defn same-month?
[d1 d2]
(and (same-year? d1 d2)
(= (t/month d1) (t/month d2)))) |
The first day of the week varies by locale, but Metabase has a setting that overrides it. In JVM, we can just read the setting directly. ---------------------------------------------- information ------------------------------------------------------- | (defn first-day-of-week [] (public-settings/start-of-week)) |
The default map of options. | (def default-options
{:locale (Locale/getDefault)}) |
------------------------------------------------ to-range -------------------------------------------------------- | (defn- minus-ms [value] (t/minus value (t/millis 1))) |
(defn- apply-offset
[value offset-n offset-unit]
(t/plus
value
(case offset-unit
:minute (t/minutes offset-n)
:hour (t/hours offset-n)
:day (t/days offset-n)
:week (t/weeks offset-n)
:month (t/months offset-n)
:year (t/years offset-n)
(t/minutes 0)))) | |
(defmethod common/to-range :default [value _]
;; Fallback: Just return a zero-width at the input time.
;; This mimics Moment.js behavior if you `m.startOf("unknown unit")` - it doesn't change anything.
[value value]) | |
(defmethod common/to-range :minute [value {:keys [n] :or {n 1}}]
(let [start (-> value
(t/truncate-to :minutes))]
[start (minus-ms (t/plus start (t/minutes n)))])) | |
(defmethod common/to-range :hour [value {:keys [n] :or {n 1}}]
(let [start (-> value
(t/truncate-to :hours))]
[start (minus-ms (t/plus start (t/hours n)))])) | |
(defmethod common/to-range :day [value {:keys [n] :or {n 1}}]
(let [start (-> value
(t/truncate-to :days))]
[start (minus-ms (t/plus start (t/days n)))])) | |
(defmethod common/to-range :week [value {:keys [n] :or {n 1}}]
(let [first-day (first-day-of-week)
start (-> value
(t/truncate-to :days)
(t/adjust :previous-or-same-day-of-week first-day))]
[start (minus-ms (t/plus start (t/weeks n)))])) | |
(defmethod common/to-range :month [value {:keys [n] :or {n 1}}]
(let [value (-> value
(t/truncate-to :days)
(t/adjust :first-day-of-month))]
[value (minus-ms (t/plus value (t/months n)))])) | |
(defmethod common/to-range :year [value {:keys [n] :or {n 1}}]
(let [value (-> value
(t/truncate-to :days)
(t/adjust :first-day-of-year))]
[value (minus-ms (nth (iterate #(t/adjust % :first-day-of-next-year n) value) n))])) | |
-------------------------------------------- string->timestamp --------------------------------------------------- | (defmethod common/string->timestamp :default [value _]
;; Best effort to parse this unknown string format, as a local zoneless datetime, then treating it as UTC.
(let [base (try (t/local-date-time value)
(catch Exception _
(try (t/local-date value)
(catch Exception _
nil))))]
(when base
(t/offset-date-time base (t/zone-id))))) |
(defmethod common/string->timestamp :day-of-week [value options]
;; Try to parse as a regular timestamp; if that fails then try to treat it as a weekday name and adjust from
;; the current time.
(let [as-default (try ((get-method common/string->timestamp :default) value options)
(catch Exception _ nil))]
(if (valid? as-default)
as-default
(let [day (try (t/day-of-week "EEE" value)
(catch Exception _
(try (t/day-of-week "EEEE" value)
(catch Exception _
(throw (ex-info (str "Failed to coerce '" value "' to day-of-week")
{:value value}))))))]
(-> (now)
(t/truncate-to :days)
(t/adjust :previous-or-same-day-of-week :monday) ; Move to ISO start of week.
(t/adjust :next-or-same-day-of-week day)))))) ; Then to the specified day. | |
Some of the date coercions are relative, and not directly involved with any particular month. To avoid errors we need to use a reference date that is (a) in a month with 31 days,(b) in a leap year. This uses 2016-01-01 for the purpose. -------------------------------------------- number->timestamp --------------------------------------------------- | (def ^:private magic-base-date (t/offset-date-time 2016 01 01)) |
(defmethod common/number->timestamp :default [value _] ;; If no unit is given, or the unit is not recognized, try to parse the number as year number, returning the timestamp ;; for midnight UTC on January 1. (t/offset-date-time value)) | |
(defmethod common/number->timestamp :minute-of-hour [value _] (-> (now) (t/truncate-to :hours) (t/plus (t/minutes value)))) | |
(defmethod common/number->timestamp :hour-of-day [value _] (-> (now) (t/truncate-to :days) (t/plus (t/hours value)))) | |
(defmethod common/number->timestamp :day-of-week [value _]
;; Metabase uses 1 to mean the start of the week, based on the Metabase setting for the first day of the week.
;; Moment uses 0 as the first day of the week in its configured locale.
;; For Java, get the first day of the week from the setting, and offset by `(dec value)` for the current day.
(-> (now)
(t/adjust :previous-or-same-day-of-week (first-day-of-week))
(t/truncate-to :days)
(t/plus (t/days (dec value))))) | |
(defmethod common/number->timestamp :day-of-month [value _] ;; We force the initial date to be in a month with 31 days. (t/plus magic-base-date (t/days (dec value)))) | |
(defmethod common/number->timestamp :day-of-year [value _] ;; We force the initial date to be in a leap year (2016). (t/plus magic-base-date (t/days (dec value)))) | |
(defmethod common/number->timestamp :week-of-year [value _]
(-> (now)
(t/truncate-to :days)
(t/adjust :first-day-of-year)
(t/adjust :previous-or-same-day-of-week (first-day-of-week))
(t/plus (t/weeks (dec value))))) | |
(defmethod common/number->timestamp :month-of-year [value _] (t/offset-date-time (t/year (now)) value 1)) | |
(defmethod common/number->timestamp :quarter-of-year [value _]
(let [month (inc (* 3 (dec value)))]
(t/offset-date-time (t/year (now)) month 1))) | |
(defmethod common/number->timestamp :year [value _] (t/offset-date-time value 1 1)) | |
Parses a timestamp with Z or a timezone offset at the end. ---------------------------------------------- parsing helpers --------------------------------------------------- | (defn parse-with-zone [value] (t/offset-date-time value)) |
Given a freshly parsed | (defn localize [value] (t/local-date-time value)) |
Parses a time string that has been stripped of any time zone. | (defn parse-time-string [value] (t/local-time value)) |
------------------------------------------------ arithmetic ------------------------------------------------------ | |
Return the number of | (defn unit-diff
[unit before after]
(let [before (cond-> before
(string? before) u.date/parse)
after (cond-> after
(string? after) u.date/parse)
;; you can't use LocalDates in durations I guess, so just convert them LocalDateTimes with time = 0
before (cond-> before
(instance? java.time.LocalDate before) (t/local-date-time 0))
after (cond-> after
(instance? java.time.LocalDate after) (t/local-date-time 0))
duration (t/duration before after)]
(case unit
:millisecond (.toMillis duration)
:second (.toSeconds duration)
:minute (.toMinutes duration)
:hour (.toHours duration)
:day (.toDays duration)
:week
(long (/ (unit-diff :day before after) 7))
:month
(let [diff-months (- (u.date/extract after :month-of-year)
(u.date/extract before :month-of-year))
diff-years (- (u.date/extract after :year)
(u.date/extract before :year))]
(+ diff-months (* diff-years 12)))
:quarter
(long (/ (unit-diff :month before after) 3))
:year
(- (u.date/extract after :year)
(u.date/extract before :year))))) |
Returns the time elapsed between | (defn day-diff [before after] (unit-diff :day before after)) |
(defn- coerce-local-date-time [input]
(cond-> input
(re-find #"(?:Z|[+-]\d\d(?::?\d\d)?)$" input) (t/offset-date-time)
:always (localize))) | |
Formats a temporal-value (iso date/time string, int for hour/minute) given the temporal-bucketing unit. If unit is nil, formats the full date/time | (defn format-unit
[input unit]
(if (string? input)
(let [time? (common/matches-time? input)
date? (common/matches-date? input)
date-time? (common/matches-date-time? input)
t (cond
time? (t/local-time input)
date? (t/local-date input)
date-time? (coerce-local-date-time input))]
(if t
(case unit
:day-of-week (t/format "EEEE" t)
:month-of-year (t/format "MMM" t)
:minute-of-hour (t/format "m" t)
:hour-of-day (t/format "h a" t)
:day-of-month (t/format "d" t)
:day-of-year (t/format "D" t)
:week-of-year (t/format "w" t)
:quarter-of-year (t/format "'Q'Q" t)
(cond
time? (t/format "h:mm a" t)
date? (t/format "MMM d, yyyy" t)
:else (t/format "MMM d, yyyy, h:mm a" t)))
input))
(if (= unit :hour-of-day)
(str (cond (zero? input) "12" (<= input 12) input :else (- input 12)) " " (if (<= input 11) "AM" "PM"))
(str input)))) |
Formats a time difference between two temporal values. Drops redundant information. | (defn format-diff
[temporal-value-1 temporal-value-2]
(let [default-format #(str (format-unit temporal-value-1 nil)
" – "
(format-unit temporal-value-2 nil))]
(cond
(some (complement string?) [temporal-value-1 temporal-value-2])
(default-format)
(= temporal-value-1 temporal-value-2)
(format-unit temporal-value-1 nil)
(and (common/matches-time? temporal-value-1)
(common/matches-time? temporal-value-2))
(default-format)
(and (common/matches-date-time? temporal-value-1)
(common/matches-date-time? temporal-value-2))
(let [lhs (coerce-local-date-time temporal-value-1)
rhs (coerce-local-date-time temporal-value-2)
year-matches? (= (t/year lhs) (t/year rhs))
month-matches? (= (t/month lhs) (t/month rhs))
day-matches? (= (t/day-of-month lhs) (t/day-of-month rhs))
hour-matches? (= (t/format "H" lhs) (t/format "H" rhs))
[lhs-fmt rhs-fmt] (cond
(and year-matches? month-matches? day-matches? hour-matches?)
["MMM d, yyyy, h:mm a " " h:mm a"]
(and year-matches? month-matches? day-matches?)
["MMM d, yyyy, h:mm a " " h:mm a"]
year-matches?
["MMM d, h:mm a " " MMM d, yyyy, h:mm a"])]
(if lhs-fmt
(str (t/format lhs-fmt lhs) "–" (t/format rhs-fmt rhs))
(default-format)))
(and (common/matches-date? temporal-value-1)
(common/matches-date? temporal-value-2))
(let [lhs (t/local-date temporal-value-1)
rhs (t/local-date temporal-value-2)
year-matches? (= (t/year lhs) (t/year rhs))
month-matches? (= (t/month lhs) (t/month rhs))
[lhs-fmt rhs-fmt] (cond
(and year-matches? month-matches?)
["MMM d" "d, yyyy"]
year-matches?
["MMM d " " MMM d, yyyy"])]
(if lhs-fmt
(str (t/format lhs-fmt lhs) "–" (t/format rhs-fmt rhs))
(default-format)))
:else
(default-format)))) |
Given a | (defn format-relative-date-range
([n unit offset-n offset-unit opts]
(format-relative-date-range (now) n unit offset-n offset-unit opts))
([t n unit offset-n offset-unit {:keys [include-current]}]
(let [offset-now (cond-> t
(neg? n) (apply-offset n unit)
(and (pos? n) (not include-current)) (apply-offset 1 unit)
(and offset-n offset-unit) (apply-offset offset-n offset-unit))
pos-n (cond-> (abs n)
include-current inc)
date-ranges (map (if (#{:hour :minute} unit)
#(t/format "yyyy-MM-dd'T'HH:mm" (t/local-date-time %))
#(str (t/local-date %)))
(common/to-range offset-now
{:unit unit
:n pos-n
:offset-n offset-n
:offset-unit offset-unit}))]
(apply format-diff date-ranges)))) |
Clojure implementation of [[metabase.shared.util.time/truncate]]; basically the same as [[u.date/truncate]] but also handles ISO-8601 strings. | (defn truncate
[t unit]
(if (string? t)
(str (truncate (u.date/parse t) unit))
(u.date/truncate t unit))) |
Clojure implementation of [[metabase.shared.util.time/add]]; basically the same as [[u.date/add]] but also handles ISO-8601 strings. | (defn add
[t unit amount]
(if (string? t)
(str (add (u.date/parse t) unit amount))
(u.date/add t unit amount))) |
Clojure implementation of [[metabase.shared.util.time/format-for-base-type]]; format a temporal value as an ISO-8601
string. | (defn format-for-base-type [t _base-type] (str t)) |
CLJS implementation of the time utilities on top of Moment.js. See [[metabase.shared.util.time]] for the public interface. | (ns metabase.shared.util.internal.time (:require ["moment" :as moment] [metabase.shared.util.internal.time-common :as common])) |
(defn- now [] (moment)) | |
Given any value, check if it's a (possibly invalid) Moment. ----------------------------------------------- predicates ------------------------------------------------------- | (defn datetime? [value] (and value (moment/isMoment value))) |
checks if the provided value is a local time value. | (defn time? [value] (moment/isMoment value)) |
Given a Moment, check that it's valid. | (defn valid? [value] (and (datetime? value) (.isValid ^moment/Moment value))) |
Does nothing. Just a placeholder in CLJS; the JVM implementation does some real work. | (defn normalize [value] value) |
Given two platform-specific datetimes, checks if they fall within the same day. | (defn same-day? [^moment/Moment d1 ^moment/Moment d2] (.isSame d1 d2 "day")) |
True if these two datetimes fall in the same (year and) month. | (defn same-month? [^moment/Moment d1 ^moment/Moment d2] (.isSame d1 d2 "month")) |
True if these two datetimes fall in the same year. | (defn same-year? [^moment/Moment d1 ^moment/Moment d2] (.isSame d1 d2 "year")) |
The first day of the week varies by locale, but Metabase has a setting that overrides it. In CLJS, Moment is already configured with that setting. ---------------------------------------------- information ------------------------------------------------------- | (defn first-day-of-week
[]
(-> (moment/weekdays 0)
(.toLowerCase)
keyword)) |
The default map of options - empty in CLJS. | (def default-options
{}) |
------------------------------------------------ to-range -------------------------------------------------------- | (defn- apply-offset [^moment/Moment value offset-n offset-unit] (.add (moment value) offset-n (name offset-unit))) |
(defmethod common/to-range :default [^moment/Moment value {:keys [n unit]}]
(let [^moment/Moment c1 (.clone value)
^moment/Moment c2 (.clone value)
^moment/Moment adjusted (if (> n 1)
(.add c2 (dec n) (name unit))
c2)]
[(.startOf c1 (name unit))
(.endOf adjusted (name unit))])) | |
NB: Only the :default for to-range is needed in CLJS, since Moment's startOf and endOf methods are doing the work. | |
-------------------------------------------- string->timestamp --------------------------------------------------- | (defmethod common/string->timestamp :default [value _] ;; Best effort to parse this unknown string format, as a local zoneless datetime, then treating it as UTC. (moment/utc value moment/ISO_8601)) |
(defmethod common/string->timestamp :day-of-week [value options]
;; Try to parse as a regular timestamp; if that fails then try to treat it as a weekday name and adjust from
;; the current time.
(let [as-default (try ((get-method common/string->timestamp :default) value options)
(catch js/Error _ nil))]
(if (valid? as-default)
as-default
(-> (now)
(.isoWeekday value)
(.startOf "day"))))) | |
Some of the date coercions are relative, and not directly involved with any particular month. To avoid errors we need to use a reference date that is (a) in a month with 31 days,(b) in a leap year. This uses 2016-01-01 for the purpose. This is a function that returns fresh values, since Moments are mutable. -------------------------------------------- number->timestamp --------------------------------------------------- | (defn- magic-base-date [] (moment "2016-01-01")) |
(defmethod common/number->timestamp :default [value _] ;; If no unit is given, or the unit is not recognized, try to parse the number as year number, returning the timestamp ;; for midnight UTC on January 1. (moment/utc value moment/ISO_8601)) | |
(defmethod common/number->timestamp :minute-of-hour [value _] (.. (now) (minute value) (startOf "minute"))) | |
(defmethod common/number->timestamp :hour-of-day [value _] (.. (now) (hour value) (startOf "hour"))) | |
(defmethod common/number->timestamp :day-of-week [value _] ;; Metabase uses 1 to mean the start of the week, based on the Metabase setting for the first day of the week. ;; Moment uses 0 as the first day of the week in its configured locale. (.. (now) (weekday (dec value)) (startOf "day"))) | |
(defmethod common/number->timestamp :day-of-month [value _] ;; We force the initial date to be in a month with 31 days. (.. (magic-base-date) (date value) (startOf "day"))) | |
(defmethod common/number->timestamp :day-of-year [value _] ;; We force the initial date to be in a leap year (2016). (.. (magic-base-date) (dayOfYear value) (startOf "day"))) | |
(defmethod common/number->timestamp :week-of-year [value _] (.. (now) (week value) (startOf "week"))) | |
(defmethod common/number->timestamp :month-of-year [value _] (.. (now) (month (dec value)) (startOf "month"))) | |
(defmethod common/number->timestamp :quarter-of-year [value _] (.. (now) (quarter value) (startOf "quarter"))) | |
(defmethod common/number->timestamp :year [value _] (.. (now) (year value) (startOf "year"))) | |
Parses a timestamp with Z or a timezone offset at the end. This requires a different API call from timestamps without time zones in CLJS. ---------------------------------------------- parsing helpers --------------------------------------------------- | (defn parse-with-zone [value] (moment/parseZone value)) |
Given a freshly parsed absolute Moment, convert it to a local one. | (defn localize [value] (.local value)) |
(def ^:private parse-time-formats
#js ["HH:mm:ss.SSS[Z]"
"HH:mm:ss.SSS"
"HH:mm:ss"
"HH:mm"]) | |
Parses a time string that has been stripped of any time zone. | (defn parse-time-string [value] (moment value parse-time-formats)) |
------------------------------------------------ arithmetic ------------------------------------------------------ | |
(declare unit-diff) | |
Returns the time elapsed between | (defn day-diff [before after] (unit-diff :day before after)) |
(defn- coerce-local-date-time [input]
(-> input
common/drop-trailing-time-zone
(moment/utc moment/ISO_8601))) | |
Formats a temporal-value (iso date/time string, int for hour/minute) given the temporal-bucketing unit. If unit is nil, formats the full date/time. Time input formatting is only defined with time units. | (defn format-unit
[input unit]
(if (string? input)
(let [time? (common/matches-time? input)
date? (common/matches-date? input)
date-time? (common/matches-date-time? input)
t (cond
;; Anchor to an arbitrary date since time inputs are only defined for
;; :hour-of-day and :minute-of-hour.
time? (moment/utc (str "2023-01-01T" input) moment/ISO_8601)
(or date? date-time?) (coerce-local-date-time input))]
(if (and t (.isValid t))
(case unit
:day-of-week (.format t "dddd")
:month-of-year (.format t "MMM")
:minute-of-hour (.format t "m")
:hour-of-day (.format t "h A")
:day-of-month (.format t "D")
:day-of-year (.format t "DDD")
:week-of-year (.format t "w")
:quarter-of-year (.format t "[Q]Q")
(cond
time? (.format t "h:mm A")
date? (.format t "MMM D, YYYY")
date-time? (.format t "MMM D, YYYY, h:mm A")))
input))
(if (= unit :hour-of-day)
(str (cond (zero? input) "12" (<= input 12) input :else (- input 12)) " " (if (<= input 11) "AM" "PM"))
(str input)))) |
Formats a time difference between two temporal values. Drops redundant information. | (defn format-diff
[temporal-value-1 temporal-value-2]
(let [default-format #(str (format-unit temporal-value-1 nil)
" – "
(format-unit temporal-value-2 nil))]
(cond
(some (complement string?) [temporal-value-1 temporal-value-2])
(default-format)
(= temporal-value-1 temporal-value-2)
(format-unit temporal-value-1 nil)
(and (common/matches-time? temporal-value-1)
(common/matches-time? temporal-value-2))
(default-format)
(and (common/matches-date-time? temporal-value-1)
(common/matches-date-time? temporal-value-2))
(let [lhs (coerce-local-date-time temporal-value-1)
rhs (coerce-local-date-time temporal-value-2)
year-matches? (= (.format lhs "YYYY") (.format rhs "YYYY"))
month-matches? (= (.format lhs "MMM") (.format rhs "MMM"))
day-matches? (= (.format lhs "D") (.format rhs "D"))
hour-matches? (= (.format lhs "HH") (.format rhs "HH"))
[lhs-fmt rhs-fmt] (cond
(and year-matches? month-matches? day-matches? hour-matches?)
["MMM D, YYYY, h:mm A " " h:mm A"]
(and year-matches? month-matches? day-matches?)
["MMM D, YYYY, h:mm A " " h:mm A"]
year-matches?
["MMM D, h:mm A " " MMM D, YYYY, h:mm A"])]
(if lhs-fmt
(str (.format lhs lhs-fmt) "–" (.format rhs rhs-fmt))
(default-format)))
(and (common/matches-date? temporal-value-1)
(common/matches-date? temporal-value-2))
(let [lhs (moment/utc temporal-value-1 moment/ISO_8601)
rhs (moment/utc temporal-value-2 moment/ISO_8601)
year-matches? (= (.format lhs "YYYY") (.format rhs "YYYY"))
month-matches? (= (.format lhs "MMM") (.format rhs "MMM"))
[lhs-fmt rhs-fmt] (cond
(and year-matches? month-matches?)
["MMM D" "D, YYYY"]
year-matches?
["MMM D " " MMM D, YYYY"])]
(if lhs-fmt
(str (.format lhs lhs-fmt) "–" (.format rhs rhs-fmt))
(default-format)))
:else
(default-format)))) |
Given a | (defn format-relative-date-range
([n unit offset-n offset-unit opts]
(format-relative-date-range (now) n unit offset-n offset-unit opts))
([t n unit offset-n offset-unit {:keys [include-current]}]
(let [offset-now (cond-> t
(neg? n) (apply-offset n unit)
(and (pos? n) (not include-current)) (apply-offset 1 unit)
(and offset-n offset-unit) (apply-offset offset-n offset-unit))
pos-n (cond-> (abs n)
include-current inc)
date-ranges (map #(.format % (if (#{:hour :minute} unit) "YYYY-MM-DDTHH:mm" "YYYY-MM-DD"))
(common/to-range offset-now
{:unit unit
:n pos-n
:offset-n offset-n
:offset-unit offset-unit}))]
(apply format-diff date-ranges)))) |
(def ^:private temporal-formats
{:offset-date-time {:regex common/offset-datetime-regex
:formats #js ["yyyy-MM-DDTHH:mm:ss.SSS[Z]"
"yyyy-MM-DDTHH:mm:ss[Z]"
"yyyy-MM-DDTHH:mm[Z]"
"yyyy-MM-DDTHH[Z]"]}
:local-date-time {:regex common/local-datetime-regex
:formats #js ["yyyy-MM-DDTHH:mm:ss.SSS"
"yyyy-MM-DDTHH:mm:ss"
"yyyy-MM-DDTHH:mm"
"yyyy-MM-DDTHH"]}
:local-date {:regex common/local-date-regex
:formats #js ["yyyy-MM-DD"
"yyyy-MM"
"yyyy"]}
:offset-time {:regex common/offset-time-regex
:formats #js ["HH:mm:ss.SSS[Z]"
"HH:mm:ss[Z]"
"HH:mm[Z]"
"HH[Z]"]}
:local-time {:regex common/local-time-regex
:formats #js ["HH:mm:ss.SSS"
"HH:mm:ss"
"HH:mm"
"HH"]}}) | |
(defn- iso-8601->moment+type
[s]
(some (fn [[value-type {:keys [regex formats]}]]
(when (re-matches regex s)
(let [parsed (moment/parseZone s formats #_strict? true)]
(when (.isValid parsed)
[parsed value-type]))))
temporal-formats)) | |
(defmulti ^:private moment+type->iso-8601
{:arglists '([moment+type])}
(fn [[_t value-type]]
value-type)) | |
(defmethod moment+type->iso-8601 :offset-date-time
[[^moment/Moment t _value-type]]
(let [format-string (cond
(pos? (.milliseconds t)) "yyyy-MM-DDTHH:mm:ss.SSS[Z]"
(pos? (.seconds t)) "yyyy-MM-DDTHH:mm:ss[Z]"
:else "yyyy-MM-DDTHH:mm[Z]")]
(.format t format-string))) | |
(defmethod moment+type->iso-8601 :local-date-time
[[^moment/Moment t _value-type]]
(let [format-string (cond
(pos? (.milliseconds t)) "yyyy-MM-DDTHH:mm:ss.SSS"
(pos? (.seconds t)) "yyyy-MM-DDTHH:mm:ss"
:else "yyyy-MM-DDTHH:mm")]
(.format t format-string))) | |
(defmethod moment+type->iso-8601 :local-date [[^moment/Moment t _value-type]] (.format t "yyyy-MM-DD")) | |
(defmethod moment+type->iso-8601 :offset-time
[[^moment/Moment t _value-type]]
(let [format-string (cond
(pos? (.milliseconds t)) "HH:mm:ss.SSS[Z]"
(pos? (.seconds t)) "HH:mm:ss[Z]"
:else "HH:mm[Z]")]
(.format t format-string))) | |
(defmethod moment+type->iso-8601 :local-time
[[^moment/Moment t _value-type]]
(let [format-string (cond
(pos? (.milliseconds t)) "HH:mm:ss.SSS"
(pos? (.seconds t)) "HH:mm:ss"
:else "HH:mm")]
(.format t format-string))) | |
(defn- ->moment ^moment/Moment [t]
(if (instance? js/Date t)
(moment/utc t)
t)) | |
Return the number of | (defn unit-diff
[unit before after]
(let [^moment/Moment before (if (string? before)
(first (iso-8601->moment+type before))
(->moment before))
^moment/Moment after (if (string? after)
(first (iso-8601->moment+type after))
(->moment after))]
(.diff after before (name unit)))) |
ClojureScript implementation of [[metabase.shared.util.time/truncate]]; supports both Moment.js instances and ISO-8601 strings. | (defn truncate
[t unit]
(if (string? t)
(let [[t value-type] (iso-8601->moment+type t)
t (truncate t unit)]
(moment+type->iso-8601 [t value-type]))
(let [^moment/Moment t (->moment t)]
(.startOf t (name unit))))) |
ClojureScript implementation of [[metabase.shared.util.time/add]]; supports both Moment.js instances and ISO-8601 strings. | (defn add
[t unit amount]
(if (string? t)
(let [[t value-type] (iso-8601->moment+type t)
t (add t unit amount)]
(moment+type->iso-8601 [t value-type]))
(let [^moment/Moment t (->moment t)]
(.add t amount (name unit))))) |
ClojureScript implementation of [[metabase.shared.util.time/format-for-base-type]]; format a temporal value as an
ISO-8601 string appropriate for a value of the given | (defn format-for-base-type
[t base-type]
(if (string? t)
t
(let [t (->moment t)
value-type (condp #(isa? %2 %1) base-type
:type/TimeWithTZ :offset-time
:type/Time :local-time
:type/DateTimeWithTZ :offset-date-time
:type/DateTime :local-date-time
:type/Date :local-date)]
(moment+type->iso-8601 [t value-type])))) |
Shared core of time utils used by the internal CLJ and CLJS implementations. See [[metabase.shared.util.time]] for the public interface. | (ns metabase.shared.util.internal.time-common) |
(defn- by-unit [_ {:keys [unit]}] (keyword unit)) | |
Given a datetime and a unit (eg. "hour"), returns an inclusive datetime range as a pair of datetimes. For a unit of an hour, and a datetime for 13:49:28, that means [13:00:00 13:59:59.999], ie. 1 ms before the end. | (defmulti to-range by-unit) |
Given a string representation of a datetime and the | (defmulti string->timestamp by-unit) |
Given a numeric representation of a datetime and the Note that for two relative units - Returns a platform-specific datetime. | (defmulti number->timestamp by-unit) |
(def ^:private year-part
"\\d{4}") | |
(def ^:private month-part
"\\d{2}") | |
(def ^:private day-part
"\\d{2}") | |
(def ^:private date-part (str year-part \- month-part \- day-part)) | |
(def ^:private hour-part
"\\d{2}") | |
(def ^:private minutes-part
"\\d{2}") | |
(defn- optional [& parts] (str "(?:" (apply str parts) ")?")) | |
(def ^:private seconds-milliseconds-part
(str ":\\d{2}" (optional "\\.\\d{1,6}"))) | |
(def ^:private time-part (str hour-part \: minutes-part (optional seconds-milliseconds-part))) | |
(def ^:private date-time-part (str date-part \T time-part)) | |
(def ^:private offset-part (str "(?:Z|(?:[+-]" time-part "))")) | |
Regex for a zone-offset string. | (def zone-offset-part-regex (re-pattern offset-part)) |
Regex for a local-date string. | (def ^:const local-date-regex (re-pattern (str \^ date-part \$))) |
Regex for a local-time string. | (def ^:const local-time-regex (re-pattern (str \^ time-part \$))) |
Regex for an offset-time string. | (def ^:const offset-time-regex (re-pattern (str \^ time-part offset-part \$))) |
Regex for a local-datetime string. | (def ^:const local-datetime-regex (re-pattern (str \^ date-time-part \$))) |
Regex for an offset-datetime string. | (def ^:const offset-datetime-regex (re-pattern (str \^ date-time-part offset-part \$))) |
Regex for a year-month literal string. | (def ^:const year-month-regex (re-pattern (str \^ year-part \- month-part \$))) |
Regex for a year literal string. | (def ^:const year-regex (re-pattern (str \^ year-part \$))) |
Matches a local time string. | (defn matches-time? [input] (re-matches local-time-regex input)) |
Matches a local date string. | (defn matches-date? [input] (re-matches local-date-regex input)) |
Matches a local AND offset date time string. | (defn matches-date-time? [input] (re-matches (re-pattern (str date-time-part (optional offset-part))) input)) |
Strips off a trailing +0500, -0430, or Z from a time string. | (defn drop-trailing-time-zone
[time-str]
(or (second (re-matches (re-pattern (str "(.*?)" (optional offset-part) \$)) time-str))
time-str)) |
Potemkin is Java-only, so here's a basic function-importing macro that works for both CLJS and CLJ. | (ns metabase.shared.util.namespaces
(:require
[net.cgrand.macrovich :as macros]
[potemkin :as p])) |
(defn- redef [target sym]
(let [defn-name (or sym (symbol (name target)))]
`(def ~defn-name "docstring" (fn [& args#] (apply ~target args#))))) | |
Imports a single defn from another namespace.
This creates a new local function that calls through to the original, so that it reloads nicely in the REPL.
| (defmacro import-fn ;; Heavily inspired by Potemkin. ([target] `(import-fn ~target nil)) ([target sym] (redef target sym))) |
Imports defns from other namespaces.
This uses [[import-fn]] to create pass-through local functions that reload nicely.
| (defmacro import-fns
[& spaces]
(macros/case
:cljs `(do
~@(for [[target-ns & fns] spaces
f fns
:let [target-sym (if (vector? f) (first f) f)
new-sym (if (vector? f) (second f) f)
target (symbol (name target-ns) (name target-sym))]]
(redef target new-sym)))
:clj `(p/import-vars ~@spaces))) |
(ns metabase.shared.util.namespaces (:require-macros [metabase.shared.util.namespaces])) | |
Time parsing helper functions. In Java these return [[OffsetDateTime]], in JavaScript they return Moments. Most of the implementations are in the split CLJ/CLJS files [[metabase.shared.util.internal.time]]. | (ns metabase.shared.util.time (:require [metabase.shared.util.internal.time :as internal] [metabase.shared.util.internal.time-common :as common] [metabase.shared.util.namespaces :as shared.ns] [metabase.util :as u])) |
Importing and re-exporting some functions defined in each implementation. | (shared.ns/import-fns [common local-date-regex local-datetime-regex local-time-regex offset-datetime-regex offset-time-regex to-range year-month-regex year-regex zone-offset-part-regex] [internal valid? same-day? same-month? same-year? day-diff unit-diff truncate add format-for-base-type]) |
(defn- prep-options [options] (merge internal/default-options (u/normalize-map options))) | |
Parses a timestamp value into a date object. This can be a straightforward Unix timestamp or ISO format string.
But the | (defn ^:export coerce-to-timestamp
([value] (coerce-to-timestamp value {}))
([value options]
(let [options (prep-options options)
base (cond
;; Just return an already-parsed value. (Moment in CLJS, DateTime classes in CLJ.)
(internal/datetime? value) (internal/normalize value)
;; If there's a timezone offset, or Z for Zulu/UTC time, parse it directly.
(and (string? value)
(re-matches #".*(Z|[+-]\d\d:?\d\d)$" value)) (internal/parse-with-zone value)
;; Then we fall back to two multimethods for coercing strings and number to timestamps per the :unit.
(string? value) (common/string->timestamp value options)
:else (common/number->timestamp value options))]
(if (:local options)
(internal/localize base)
base)))) |
Parses a standalone time, or the time portion of a timestamp. Accepts a platform time value (eg. Moment, OffsetTime, LocalTime) or a string. | (defn ^:export coerce-to-time
[value]
(cond
(internal/time? value) value
(string? value) (-> value common/drop-trailing-time-zone internal/parse-time-string)
:else (throw (ex-info "Unknown input to coerce-to-time; expecting a string"
{:value value})))) |
Formats a temporal-value (iso date/time string, int for hour/minute) given the temporal-bucketing unit. If unit is nil, formats the full date/time | (defn format-unit [temporal-value unit] (internal/format-unit temporal-value unit)) |
Formats a time difference between two temporal values. Drops redundant information. | (defn format-diff [temporal-value-1 temporal-value-2] (internal/format-diff temporal-value-1 temporal-value-2)) |
Given a | (defn format-relative-date-range ([n unit] (format-relative-date-range n unit nil nil nil)) ([n unit offset-n offset-unit] (format-relative-date-range n unit offset-n offset-unit nil)) ([n unit offset-n offset-unit options] (internal/format-relative-date-range n unit offset-n offset-unit options)) ([t n unit offset-n offset-unit options] (internal/format-relative-date-range (coerce-to-timestamp t) n unit offset-n offset-unit options))) |
Combined functions for running the entire Metabase sync process. This delegates to a few distinct steps, which in turn are broken out even further:
| (ns metabase.sync (:require [metabase.driver.h2 :as h2] [metabase.driver.util :as driver.u] [metabase.models.field :as field] [metabase.models.table :as table] [metabase.sync.analyze :as analyze] [metabase.sync.analyze.fingerprint :as fingerprint] [metabase.sync.field-values :as field-values] [metabase.sync.interface :as i] [metabase.sync.sync-metadata :as sync-metadata] [metabase.sync.util :as sync-util] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms]) (:import (java.time.temporal Temporal))) |
Schema for results returned from [[sync-database!]]. | (def ^:private SyncDatabaseResults
[:maybe
[:sequential
[:map
[:start-time (ms/InstanceOfClass Temporal)]
[:end-time (ms/InstanceOfClass Temporal)]
[:name :string]
[:steps [:maybe [:sequential sync-util/StepNameWithMetadata]]]]]]) |
(mu/defn sync-database! :- SyncDatabaseResults
"Perform all the different sync operations synchronously for `database`.
By default, does a `:full` sync that performs all the different sync operations consecutively. You may instead
specify only a `:schema` sync that will sync just the schema but skip analysis.
Please note that this function is *not* what is called by the scheduled tasks; those call different steps
independently. This function is called when a Database is first added."
([database]
(sync-database! database nil))
([database :- i/DatabaseInstance
{:keys [scan], :or {scan :full}} :- [:maybe [:map
[:scan {:optional true} [:maybe [:enum :schema :full]]]]]]
(sync-util/sync-operation :sync database (format "Sync %s" (sync-util/name-for-logging database))
(cond-> [(assoc (sync-metadata/sync-db-metadata! database) :name "metadata")]
(= scan :full)
(conj (assoc (analyze/analyze-db! database) :name "analyze")
(assoc (field-values/update-field-values! database) :name "field-values")))))) | |
Perform all the different sync operations synchronously for a given | (mu/defn sync-table!
[table :- i/TableInstance]
(doto table
sync-metadata/sync-table-metadata!
analyze/analyze-table!
field-values/update-field-values-for-table!
sync-util/set-initial-table-sync-complete!)) |
Refingerprint a field, usually after its type changes. Checks if can connect to database, returning
| (mu/defn refingerprint-field!
[field :- i/FieldInstance]
(let [table (field/table field)
database (table/database table)]
;; it's okay to allow testing H2 connections during sync. We only want to disallow you from testing them for the
;; purposes of creating a new H2 database.
(if (binding [h2/*allow-testing-h2-connections* true]
(driver.u/can-connect-with-details? (:engine database) (:details database)))
(sync-util/with-error-handling (format "Error refingerprinting field %s"
(sync-util/name-for-logging field))
(fingerprint/refingerprint-field field))
:sync/no-connection))) |
Logic responsible for doing deep 'analysis' of the data inside a database. This is significantly more expensive than the basic sync-metadata step, and involves things like running MBQL queries and fetching values to do things like determine Table row counts and infer field semantic types. | (ns metabase.sync.analyze (:require [metabase.models.field :refer [Field]] [metabase.sync.analyze.classify :as classify] [metabase.sync.analyze.fingerprint :as fingerprint] [metabase.sync.interface :as i] [metabase.sync.util :as sync-util] [metabase.util :as u] [metabase.util.log :as log] [metabase.util.malli :as mu] [toucan2.core :as t2])) |
How does analysis decide which Fields should get analyzed? Good question. There are two situations in which Fields should get analyzed:
So how do we check all that?
So what happens during the next analysis? During the next analysis phase, Fields whose fingerprint is up-to-date will be skipped. However, if a new
fingerprint version is introduced, Fields that need it will be upgraded to it. We'll still only reclassify the
newly re-fingerprinted Fields, because we'll know to skip the ones from last time since their value of
| |
(mu/defn ^:private update-last-analyzed!
[tables :- [:sequential i/TableInstance]]
(when-let [ids (seq (map u/the-id tables))]
;; The WHERE portion of this query should match up with that of `classify/fields-to-classify`
(t2/update! Field {:table_id [:in ids]
:fingerprint_version i/*latest-fingerprint-version*
:last_analyzed nil}
{:last_analyzed :%now}))) | |
Update the | (mu/defn ^:private update-fields-last-analyzed! [table :- i/TableInstance] (update-last-analyzed! [table])) |
Update the | (mu/defn ^:private update-fields-last-analyzed-for-db! [_database :- i/DatabaseInstance tables :- [:sequential i/TableInstance]] ;; The WHERE portion of this query should match up with that of `classify/fields-to-classify` (update-last-analyzed! tables)) |
Perform in-depth analysis for a | (mu/defn analyze-table! [table :- i/TableInstance] (fingerprint/fingerprint-fields! table) (classify/classify-fields! table) (classify/classify-table! table) (update-fields-last-analyzed! table)) |
(defn- maybe-log-progress [progress-bar-fn]
(fn [step table]
(let [progress-bar-result (progress-bar-fn)]
(when progress-bar-result
(log/info (u/format-color 'blue "%s Analyzed %s %s" step progress-bar-result (sync-util/name-for-logging table))))))) | |
(defn- fingerprint-fields-summary [{:keys [fingerprints-attempted updated-fingerprints no-data-fingerprints failed-fingerprints]}]
(format "Fingerprint updates attempted %d, updated %d, no data found %d, failed %d"
fingerprints-attempted updated-fingerprints no-data-fingerprints failed-fingerprints)) | |
(defn- classify-fields-summary [{:keys [fields-classified fields-failed]}]
(format "Total number of fields classified %d, %d failed"
fields-classified fields-failed)) | |
(defn- classify-tables-summary [{:keys [total-tables tables-classified]}]
(format "Total number of tables classified %d, %d updated"
total-tables tables-classified)) | |
(defn- make-analyze-steps [tables log-fn]
[(sync-util/create-sync-step "fingerprint-fields"
#(fingerprint/fingerprint-fields-for-db! % tables log-fn)
fingerprint-fields-summary)
(sync-util/create-sync-step "classify-fields"
#(classify/classify-fields-for-db! % tables log-fn)
classify-fields-summary)
(sync-util/create-sync-step "classify-tables"
#(classify/classify-tables-for-db! % tables log-fn)
classify-tables-summary)]) | |
Perform in-depth analysis on the data for all Tables in a given | (mu/defn analyze-db!
[database :- i/DatabaseInstance]
(sync-util/sync-operation :analyze database (format "Analyze data for %s" (sync-util/name-for-logging database))
(let [tables (sync-util/db->sync-tables database)]
(sync-util/with-emoji-progress-bar [emoji-progress-bar (inc (* 3 (count tables)))]
(u/prog1 (sync-util/run-sync-operation "analyze" database (make-analyze-steps tables (maybe-log-progress emoji-progress-bar)))
(update-fields-last-analyzed-for-db! database tables)))))) |
Refingerprint a subset of tables in a given | (mu/defn refingerprint-db!
[database :- i/DatabaseInstance]
(sync-util/sync-operation :refingerprint database (format "Refingerprinting tables for %s" (sync-util/name-for-logging database))
(let [tables (sync-util/db->sync-tables database)
log-fn (fn [step table]
(log/info (u/format-color 'blue "%s Analyzed %s" step (sync-util/name-for-logging table))))]
(sync-util/run-sync-operation "refingerprint database"
database
[(sync-util/create-sync-step "refingerprinting fields"
#(fingerprint/refingerprint-fields-for-db! % tables log-fn)
fingerprint-fields-summary)])))) |
Classifier that determines whether a Field should be marked as a As of Metabase v0.29, the Category now longer has any use inside of the Metabase backend; it is used
only for frontend purposes (e.g. deciding which widget to show). Previously, makring something as a Category meant
that its values should be cached and saved in a FieldValues object. With the changes in v0.29, this is instead
managed by a column called A value of | (ns metabase.sync.analyze.classifiers.category (:require [metabase.lib.schema.metadata :as lib.schema.metadata] [metabase.models.field-values :as field-values] [metabase.sync.interface :as i] [metabase.sync.util :as sync-util] [metabase.util.log :as log] [metabase.util.malli :as mu])) |
(defn- cannot-be-category-or-list?
[{base-type :base_type, semantic-type :semantic_type}]
(or (isa? base-type :type/Temporal)
(isa? base-type :type/Collection)
(isa? base-type :type/Float)
;; Don't let IDs become list Fields (they already can't become categories, because they already have a semantic
;; type). It just doesn't make sense to cache a sequence of numbers since they aren't inherently meaningful
(isa? semantic-type :type/PK)
(isa? semantic-type :type/FK))) | |
(mu/defn ^:private field-should-be-category? :- [:maybe :boolean]
[fingerprint :- [:maybe i/Fingerprint]
field :- i/FieldInstance]
(let [distinct-count (get-in fingerprint [:global :distinct-count])
nil% (get-in fingerprint [:global :nil%])]
;; Only mark a Field as a Category if it doesn't already have a semantic type.
(when (and (nil? (:semantic_type field))
(or (some-> nil% (< 1))
(isa? (:base_type field) :type/Boolean))
(some-> distinct-count (<= field-values/category-cardinality-threshold)))
(log/debug (format "%s has %d distinct values. Since that is less than %d, we're marking it as a category."
(sync-util/name-for-logging field)
distinct-count
field-values/category-cardinality-threshold))
true))) | |
(mu/defn ^:private field-should-be-auto-list? :- [:maybe :boolean]
"Based on `distinct-count`, should we mark this `field` as `has-field-values` = `auto-list`?"
[fingerprint :- [:maybe i/Fingerprint]
field :- [:map [:has-field-values {:optional true} [:maybe ::lib.schema.metadata/column.has-field-values]]]]
;; only update has-field-values if it hasn't been set yet. If it's already been set then it was probably done so
;; manually by an admin, and we don't want to stomp over their choices.
(let [distinct-count (get-in fingerprint [:global :distinct-count])]
(when (and (nil? (:has-field-values field))
(some-> distinct-count (<= field-values/auto-list-cardinality-threshold)))
(log/debug (format "%s has %d distinct values. Since that is less than %d, it should have cached FieldValues."
(sync-util/name-for-logging field)
distinct-count
field-values/auto-list-cardinality-threshold))
true))) | |
(mu/defn infer-is-category-or-list :- [:maybe i/FieldInstance]
"Classifier that attempts to determine whether `field` ought to be marked as a Category based on its distinct count."
[field :- i/FieldInstance
fingerprint :- [:maybe i/Fingerprint]]
(when (and fingerprint
(not (cannot-be-category-or-list? field)))
(cond-> field
(field-should-be-category? fingerprint field) (assoc :semantic_type :type/Category)
(field-should-be-auto-list? fingerprint field) (assoc :has_field_values :auto-list)))) | |
Classifier that infers the semantic type of a Field based on its name and base type. | (ns metabase.sync.analyze.classifiers.name (:require [clojure.string :as str] [metabase.config :as config] [metabase.driver.util :as driver.u] [metabase.sync.interface :as i] [metabase.sync.util :as sync-util] [metabase.util :as u] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms])) |
(def ^:private bool-or-int-type #{:type/Boolean :type/Integer})
(def ^:private float-type #{:type/Float})
(def ^:private int-type #{:type/Integer})
(def ^:private int-or-text-type #{:type/Integer :type/Text})
(def ^:private text-type #{:type/Text})
(def ^:private timestamp-type #{:type/DateTime})
(def ^:private time-type #{:type/Time})
(def ^:private date-type #{:type/Date})
(def ^:private number-type #{:type/Number})
(def ^:private any-type #{:type/*}) | |
Tuples of
| (def ^:private pattern+base-types+semantic-type [[#"^id$" any-type :type/PK] [#"^lon$" float-type :type/Longitude] [#"^.*_lon$" float-type :type/Longitude] [#"^.*_lng$" float-type :type/Longitude] [#"^.*_long$" float-type :type/Longitude] [#"^.*_longitude$" float-type :type/Longitude] [#"^lng$" float-type :type/Longitude] [#"^long$" float-type :type/Longitude] [#"^longitude$" float-type :type/Longitude] [#"^lat$" float-type :type/Latitude] [#"^.*_lat$" float-type :type/Latitude] [#"^latitude$" float-type :type/Latitude] [#"^.*_latitude$" float-type :type/Latitude] [#"^.*_type$" int-or-text-type :type/Category] [#"^.*_url$" text-type :type/URL] [#"^active$" bool-or-int-type :type/Category] [#"^city$" text-type :type/City] [#"^country" text-type :type/Country] [#"_country$" text-type :type/Country] [#"^currency$" int-or-text-type :type/Category] [#"^first(?:_?)name$" text-type :type/Name] [#"^full(?:_?)name$" text-type :type/Name] [#"^gender$" int-or-text-type :type/Category] [#"^last(?:_?)name$" text-type :type/Name] [#"^name$" text-type :type/Name] [#"^postal(?:_?)code$" int-or-text-type :type/ZipCode] [#"^role$" int-or-text-type :type/Category] [#"^sex$" int-or-text-type :type/Category] [#"^status$" int-or-text-type :type/Category] [#"^type$" int-or-text-type :type/Category] [#"^url$" text-type :type/URL] [#"^zip(?:_?)code$" int-or-text-type :type/ZipCode] [#"discount" number-type :type/Discount] [#"income" number-type :type/Income] [#"quantity" int-type :type/Quantity] [#"count$" int-type :type/Quantity] [#"number" int-type :type/Quantity] [#"^num_" int-type :type/Quantity] [#"join" date-type :type/JoinDate] [#"join" time-type :type/JoinTime] [#"join" timestamp-type :type/JoinTimestamp] [#"create" date-type :type/CreationDate] [#"create" time-type :type/CreationTime] [#"create" timestamp-type :type/CreationTimestamp] [#"start" date-type :type/CreationDate] [#"start" time-type :type/CreationTime] [#"start" timestamp-type :type/CreationTimestamp] [#"cancel" date-type :type/CancelationDate] [#"cancel" time-type :type/CancelationTime] [#"cancel" timestamp-type :type/CancelationTimestamp] [#"delet(?:e|i)" date-type :type/DeletionDate] [#"delet(?:e|i)" time-type :type/DeletionTime] [#"delet(?:e|i)" timestamp-type :type/DeletionTimestamp] [#"update" date-type :type/UpdatedDate] [#"update" time-type :type/UpdatedTime] [#"update" timestamp-type :type/UpdatedTimestamp] [#"source" int-or-text-type :type/Source] [#"channel" int-or-text-type :type/Source] [#"share" float-type :type/Share] [#"percent" float-type :type/Share] [#"rate$" float-type :type/Share] [#"margin" number-type :type/GrossMargin] [#"cost" number-type :type/Cost] [#"duration" number-type :type/Duration] [#"author" int-or-text-type :type/Author] [#"creator" int-or-text-type :type/Author] [#"created(?:_?)by" int-or-text-type :type/Author] [#"owner" int-or-text-type :type/Owner] [#"company" int-or-text-type :type/Company] [#"vendor" int-or-text-type :type/Company] [#"subscription" int-or-text-type :type/Subscription] [#"score" number-type :type/Score] [#"rating" number-type :type/Score] [#"stars" number-type :type/Score] [#"description" text-type :type/Description] [#"title" text-type :type/Title] [#"comment" text-type :type/Comment] [#"birthda(?:te|y)" date-type :type/Birthdate] [#"birthda(?:te|y)" timestamp-type :type/Birthdate] [#"(?:te|y)(?:_?)of(?:_?)birth" date-type :type/Birthdate] [#"(?:te|y)(?:_?)of(?:_?)birth" timestamp-type :type/Birthdate]]) |
Check that all the pattern tuples are valid | (when-not config/is-prod?
(doseq [[name-pattern base-types semantic-type] pattern+base-types+semantic-type]
(assert (instance? java.util.regex.Pattern name-pattern))
(assert (every? #(isa? % :type/*) base-types))
(assert (or (isa? semantic-type :Semantic/*)
(isa? semantic-type :Relation/*))))) |
(mu/defn ^:private semantic-type-for-name-and-base-type :- [:maybe ms/FieldSemanticOrRelationType]
"If `name` and `base-type` matches a known pattern, return the `semantic-type` we should assign to it."
[field-name :- ms/NonBlankString
base-type :- ms/FieldType]
(let [field-name (u/lower-case-en field-name)]
(some (fn [[name-pattern valid-base-types semantic-type]]
(when (and (some (partial isa? base-type) valid-base-types)
(re-find name-pattern field-name))
semantic-type))
pattern+base-types+semantic-type))) | |
Schema that allows a | (def ^:private FieldOrColumn
[:and
[:map
;; Some DBs such as MSSQL can return columns with blank name
[:name :string]
[:base_type :keyword]
[:semantic_type {:optional true} [:maybe :keyword]]]
::i/no-kebab-case-keys]) |
(mu/defn infer-semantic-type :- [:maybe :keyword]
"Classifer that infers the semantic type of a `field` based on its name and base type."
[field-or-column :- FieldOrColumn]
;; Don't overwrite keys, else we're ok with overwriting as a new more precise type might have
;; been added.
(when-not (or (some (partial isa? (:semantic_type field-or-column)) [:type/PK :type/FK])
(str/blank? (:name field-or-column)))
(semantic-type-for-name-and-base-type (:name field-or-column) (:base_type field-or-column)))) | |
(mu/defn infer-and-assoc-semantic-type :- [:maybe FieldOrColumn]
"Returns `field-or-column` with a computed semantic type based on the name and base type of the `field-or-column`"
[field-or-column :- FieldOrColumn
_fingerprint :- [:maybe i/Fingerprint]]
(when-let [inferred-semantic-type (infer-semantic-type field-or-column)]
(log/debug (format "Based on the name of %s, we're giving it a semantic type of %s."
(sync-util/name-for-logging field-or-column)
inferred-semantic-type))
(assoc field-or-column :semantic_type inferred-semantic-type))) | |
(defn- prefix-or-postfix [s] (re-pattern (format "(?:^%s)|(?:%ss?$)" s s))) | |
(def ^:private entity-types-patterns [[(prefix-or-postfix "order") :entity/TransactionTable] [(prefix-or-postfix "transaction") :entity/TransactionTable] [(prefix-or-postfix "sale") :entity/TransactionTable] [(prefix-or-postfix "product") :entity/ProductTable] [(prefix-or-postfix "user") :entity/UserTable] [(prefix-or-postfix "account") :entity/UserTable] [(prefix-or-postfix "people") :entity/UserTable] [(prefix-or-postfix "person") :entity/UserTable] [(prefix-or-postfix "employee") :entity/UserTable] [(prefix-or-postfix "event") :entity/EventTable] [(prefix-or-postfix "checkin") :entity/EventTable] [(prefix-or-postfix "log") :entity/EventTable] [(prefix-or-postfix "subscription") :entity/SubscriptionTable] [(prefix-or-postfix "company") :entity/CompanyTable] [(prefix-or-postfix "companies") :entity/CompanyTable] [(prefix-or-postfix "vendor") :entity/CompanyTable]]) | |
(mu/defn infer-entity-type :- i/TableInstance
"Classifer that infers the semantic type of a `table` based on its name."
[table :- i/TableInstance]
(let [table-name (-> table :name u/lower-case-en)]
(assoc table :entity_type (or (some (fn [[pattern type]]
(when (re-find pattern table-name)
type))
entity-types-patterns)
(case (some-> (:db_id table) driver.u/database->driver)
:googleanalytics :entity/GoogleAnalyticsTable
:druid :entity/EventTable
nil)
:entity/GenericTable)))) | |
Classifier that decides whether a Field should be marked 'No Preview Display'. (This means Fields are generally not shown in Table results and the like, but still shown in a single-row object detail page.) | (ns metabase.sync.analyze.classifiers.no-preview-display (:require [metabase.sync.interface :as i] [metabase.util.malli :as mu])) |
Fields whose values' average length is greater than this amount should be marked as | (def ^:private ^:const ^Long average-length-no-preview-threshold 50) |
(defn- long-plain-text-field?
[{base-type :base_type, semantic-type :semantic_type} fingerprint]
(and (isa? base-type :type/Text)
(contains? #{nil :type/SerializedJSON} semantic-type)
(some-> fingerprint
(get-in [:type :type/Text :average-length])
(> average-length-no-preview-threshold)))) | |
(mu/defn infer-no-preview-display :- [:maybe i/FieldInstance]
"Classifier that determines whether `field` should be marked 'No Preview Display'. If `field` is textual and its
average length is too great, mark it so it isn't displayed in the UI."
[field :- i/FieldInstance
fingerprint :- [:maybe i/Fingerprint]]
(when (long-plain-text-field? field fingerprint)
(assoc field :preview_display false))) | |
Logic for inferring the semantic types of Text fields based on their TextFingerprints. These tests only run against Fields that don't have existing semantic types. | (ns metabase.sync.analyze.classifiers.text-fingerprint (:require [metabase.sync.interface :as i] [metabase.sync.util :as sync-util] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms])) |
Fields that have at least this percent of values that are satisfy some predicate (such as | (def ^:private ^:const ^Double percent-valid-threshold 0.95) |
Fields that have at least this lower percent of values that satisfy some predicate (such as | (def ^:private ^Double lower-percent-valid-threshold 0.7) |
Is the value of | (mu/defn ^:private percent-key-above-threshold?
[threshold :- :double
text-fingerprint :- i/TextFingerprint
percent-key :- :keyword]
(when-let [percent (get text-fingerprint percent-key)]
(>= percent threshold))) |
Map of keys inside the | (def ^:private percent-key->semantic-type
{:percent-json [:type/SerializedJSON percent-valid-threshold]
:percent-url [:type/URL percent-valid-threshold]
:percent-email [:type/Email percent-valid-threshold]
:percent-state [:type/State lower-percent-valid-threshold]}) |
(mu/defn ^:private infer-semantic-type-for-text-fingerprint :- [:maybe ms/FieldType]
"Check various percentages inside the `text-fingerprint` and return the corresponding semantic type to mark the Field
as if the percent passes the threshold."
[text-fingerprint :- i/TextFingerprint]
(some (fn [[percent-key [semantic-type threshold]]]
(when (percent-key-above-threshold? threshold text-fingerprint percent-key)
semantic-type))
percent-key->semantic-type)) | |
We can edit the semantic type if its currently unset or if it was set during the current analysis phase. The original
field might exist in the metadata at | (defn- can-edit-semantic-type?
[field]
(or (nil? (:semantic_type field))
(let [original (get (meta field) :sync.classify/original)]
(and original
(nil? (:semantic_type original)))))) |
(mu/defn infer-semantic-type :- [:maybe i/FieldInstance]
"Do classification for `:type/Text` Fields with a valid `TextFingerprint`.
Currently this only checks the various recorded percentages, but this is subject to change in the future."
[field :- i/FieldInstance
fingerprint :- [:maybe i/Fingerprint]]
(when (and (isa? (:base_type field) :type/Text)
(can-edit-semantic-type? field))
(when-let [text-fingerprint (get-in fingerprint [:type :type/Text])]
(when-let [inferred-semantic-type (infer-semantic-type-for-text-fingerprint text-fingerprint)]
(log/debug (format "Based on the fingerprint of %s, we're marking it as %s."
(sync-util/name-for-logging field) inferred-semantic-type))
(assoc field
:semantic_type inferred-semantic-type))))) | |
Analysis sub-step that takes a fingerprint for a Field and infers and saves appropriate information like special type. Each 'classifier' takes the information available to it and decides whether or not to run. We currently have the following classifiers:
All classifier functions take two arguments, a In the future, we plan to add more classifiers, including ML ones that run offline. | (ns metabase.sync.analyze.classify
(:require
[clojure.data :as data]
[metabase.lib.metadata :as lib.metadata]
[metabase.models.interface :as mi]
[metabase.query-processor.store :as qp.store]
[metabase.sync.analyze.classifiers.category :as classifiers.category]
[metabase.sync.analyze.classifiers.name :as classifiers.name]
[metabase.sync.analyze.classifiers.no-preview-display
:as classifiers.no-preview-display]
[metabase.sync.analyze.classifiers.text-fingerprint
:as classifiers.text-fingerprint]
[metabase.sync.interface :as i]
[metabase.sync.util :as sync-util]
[metabase.util :as u]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[toucan2.core :as t2])) |
+----------------------------------------------------------------------------------------------------------------+ | CLASSIFYING INDIVIDUAL FIELDS | +----------------------------------------------------------------------------------------------------------------+ | |
Columns of Field that classifiers are allowed to set. | (def ^:private values-that-can-be-set
#{:semantic_type :preview_display :has_field_values :entity_type}) |
(def ^:private FieldOrTableInstance [:or i/FieldInstance i/TableInstance]) | |
Save the updates in | (mu/defn ^:private save-model-updates!
[original-model :- FieldOrTableInstance
updated-model :- FieldOrTableInstance]
(assert (= (type original-model) (type updated-model)))
(let [[_ values-to-set] (data/diff original-model updated-model)]
(when (seq values-to-set)
(log/debug (format "Based on classification, updating these values of %s: %s"
(sync-util/name-for-logging original-model)
values-to-set)))
;; Check that we're not trying to set anything that we're not allowed to
(doseq [k (keys values-to-set)]
(when-not (contains? values-that-can-be-set k)
(throw (Exception. (format "Classifiers are not allowed to set the value of %s." k)))))
;; cool, now we should be ok to update the model
(when values-to-set
(t2/update! (if (mi/instance-of? :model/Field original-model)
:model/Field
:model/Table)
(u/the-id original-model)
values-to-set)
true))) |
Various classifier functions available. These should all take two args, a A classifier may see the original field (before any classifiers were run) in the metadata of the field at
| (def ^:private classifiers [#'classifiers.name/infer-and-assoc-semantic-type #'classifiers.category/infer-is-category-or-list #'classifiers.no-preview-display/infer-no-preview-display #'classifiers.text-fingerprint/infer-semantic-type]) |
(mu/defn run-classifiers :- i/FieldInstance
"Run all the available `classifiers` against `field` and `fingerprint`, and return the resulting `field` with
changes decided upon by the classifiers. The original field can be accessed in the metadata at
`:sync.classify/original`."
[field :- i/FieldInstance
fingerprint :- [:maybe i/Fingerprint]]
(reduce (fn [field classifier]
(or (sync-util/with-error-handling (format "Error running classifier on %s"
(sync-util/name-for-logging field))
(classifier field fingerprint))
field))
(vary-meta field assoc :sync.classify/original field)
classifiers)) | |
Run various classifiers on | (mu/defn ^:private classify!
([field :- i/FieldInstance]
(classify! field (or (:fingerprint field)
(when (qp.store/initialized?)
(:fingerprint (lib.metadata/field (qp.store/metadata-provider) (u/the-id field))))
(t2/select-one-fn :fingerprint :model/Field :id (u/the-id field)))))
([field :- i/FieldInstance
fingerprint :- [:maybe i/Fingerprint]]
(sync-util/with-error-handling (format "Error classifying %s" (sync-util/name-for-logging field))
(let [updated-field (run-classifiers field fingerprint)]
(when-not (= field updated-field)
(save-model-updates! field updated-field)))))) |
+------------------------------------------------------------------------------------------------------------------+ | CLASSIFYING ALL FIELDS IN A TABLE | +------------------------------------------------------------------------------------------------------------------+ | |
(mu/defn ^:private fields-to-classify :- [:maybe [:sequential i/FieldInstance]]
"Return a sequences of Fields belonging to `table` for which we should attempt to determine semantic type. This
should include Fields that have the latest fingerprint, but have not yet *completed* analysis."
[table :- i/TableInstance]
(seq (t2/select :model/Field
:table_id (u/the-id table)
:fingerprint_version i/*latest-fingerprint-version*
:last_analyzed nil))) | |
Run various classifiers on the appropriate | (mu/defn classify-fields!
[table :- i/TableInstance]
(when-let [fields (fields-to-classify table)]
{:fields-classified (count fields)
:fields-failed (->> fields
(map classify!)
(filter (partial instance? Exception))
count)})) |
Run various classifiers on the | (mu/defn ^:always-validate classify-table!
[table :- i/TableInstance]
(let [updated-table (sync-util/with-error-handling (format "Error running classifier on %s"
(sync-util/name-for-logging table))
(classifiers.name/infer-entity-type table))]
(if (instance? Exception updated-table)
table
(save-model-updates! table updated-table)))) |
Classify all tables found in a given database | (mu/defn classify-tables-for-db!
[_database :- i/DatabaseInstance
tables :- [:maybe [:sequential i/TableInstance]]
log-progress-fn]
{:total-tables (count tables)
:tables-classified (sync-util/sum-numbers (fn [table]
(let [result (classify-table! table)]
(log-progress-fn "classify-tables" table)
(if result
1
0)))
tables)}) |
Classify all fields found in a given database | (mu/defn classify-fields-for-db!
[_database :- i/DatabaseInstance
tables :- [:maybe [:sequential i/TableInstance]]
log-progress-fn]
(apply merge-with +
{:fields-classified 0, :fields-failed 0}
(map (fn [table]
(let [result (classify-fields! table)]
(log-progress-fn "classify-fields" table)
result))
tables))) |
Analysis sub-step that takes a sample of values for a Field and saving a non-identifying fingerprint used for classification. This fingerprint is saved as a column on the Field it belongs to. | (ns metabase.sync.analyze.fingerprint (:require [clojure.set :as set] [honey.sql.helpers :as sql.helpers] [metabase.db.metadata-queries :as metadata-queries] [metabase.db.util :as mdb.u] [metabase.driver :as driver] [metabase.driver.util :as driver.u] [metabase.models.field :as field :refer [Field]] [metabase.models.table :as table] [metabase.query-processor.store :as qp.store] [metabase.sync.analyze.fingerprint.fingerprinters :as fingerprinters] [metabase.sync.interface :as i] [metabase.sync.util :as sync-util] [metabase.util :as u] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.registry :as mr] [metabase.util.malli.schema :as ms] [redux.core :as redux] [toucan2.core :as t2])) |
(comment metadata-queries/keep-me-for-default-table-row-sample) | |
(mu/defn ^:private save-fingerprint!
[field :- i/FieldInstance
fingerprint :- [:maybe i/Fingerprint]]
(log/debugf "Saving fingerprint for %s" (sync-util/name-for-logging field))
;; All Fields who get new fingerprints should get marked as having the latest fingerprint version, but we'll
;; clear their values for `last_analyzed`. This way we know these fields haven't "completed" analysis for the
;; latest fingerprints.
(t2/update! Field (u/the-id field)
{:fingerprint fingerprint
:fingerprint_version i/*latest-fingerprint-version*
:last_analyzed nil})) | |
(mr/def ::FingerprintStats [:map [:no-data-fingerprints ms/IntGreaterThanOrEqualToZero] [:failed-fingerprints ms/IntGreaterThanOrEqualToZero] [:updated-fingerprints ms/IntGreaterThanOrEqualToZero] [:fingerprints-attempted ms/IntGreaterThanOrEqualToZero]]) | |
(mu/defn empty-stats-map :- ::FingerprintStats
"The default stats before any fingerprints happen"
[fields-count :- ms/IntGreaterThanOrEqualToZero]
{:no-data-fingerprints 0
:failed-fingerprints 0
:updated-fingerprints 0
:fingerprints-attempted fields-count}) | |
The maximum size of :type/Text to be selected from the database in | (def ^:private ^:dynamic *truncation-size* 1234) |
(mu/defn ^:private fingerprint-table!
[table :- i/TableInstance
fields :- [:maybe [:sequential i/FieldInstance]]]
(let [rff (fn [_metadata]
(redux/post-complete
(fingerprinters/fingerprint-fields fields)
(fn [fingerprints]
(reduce (fn [count-info [field fingerprint]]
(cond
(instance? Throwable fingerprint)
(update count-info :failed-fingerprints inc)
(some-> fingerprint :global :distinct-count zero?)
(update count-info :no-data-fingerprints inc)
:else
(do
(save-fingerprint! field fingerprint)
(update count-info :updated-fingerprints inc))))
(empty-stats-map (count fingerprints))
(map vector fields fingerprints)))))
driver (driver.u/database->driver (table/database table))
opts {:truncation-size *truncation-size*}]
(driver/table-rows-sample driver table fields rff opts))) | |
+----------------------------------------------------------------------------------------------------------------+ | WHICH FIELDS NEED UPDATED FINGERPRINTS? | +----------------------------------------------------------------------------------------------------------------+ | |
Logic for building the somewhat-complicated query we use to determine which Fields need new Fingerprints This ends up giving us a SQL query that looks something like: SELECT * FROM metabase_field WHERE active = true AND (semantictype NOT IN ('type/PK') OR semantictype IS NULL) AND preview_display = true AND visibility_type <> 'retired' AND table_id = 1 AND ((fingerprint_version < 1 AND base_type IN ("type/Longitude", "type/Latitude", "type/Integer")) OR (fingerprint_version < 2 AND base_type IN ("type/Text", "type/SerializedJSON"))) | |
(mu/defn ^:private base-types->descendants :- [:maybe [:set ms/FieldTypeKeywordOrString]]
"Given a set of `base-types` return an expanded set that includes those base types as well as all of their
descendants. These types are converted to strings so HoneySQL doesn't confuse them for columns."
[base-types :- [:set ms/FieldType]]
(into #{}
(comp (mapcat (fn [base-type]
(cons base-type (descendants base-type))))
(map u/qualified-name))
base-types)) | |
It's even cooler if we could generate efficient SQL that looks at what types have already been marked for upgrade so we don't need to generate overly-complicated queries. e.g. instead of doing: WHERE ((version < 2 AND base_type IN ("type/Integer", "type/BigInteger", "type/Text")) OR (version < 1 AND base_type IN ("type/Boolean", "type/Integer", "type/BigInteger"))) we could do: WHERE ((version < 2 AND base_type IN ("type/Integer", "type/BigInteger", "type/Text")) OR (version < 1 AND base_type IN ("type/Boolean"))) (In the example above, something that is a This way we can also completely omit adding clauses for versions that have been "eclipsed" by others. This would keep the SQL query from growing boundlessly as new fingerprint versions are added | (mu/defn ^:private versions-clauses :- [:maybe [:sequential :any]]
[]
;; keep track of all the base types (including descendants) for each version, starting from most recent
(let [versions+base-types (reverse (sort-by first (seq i/*fingerprint-version->types-that-should-be-re-fingerprinted*)))
already-seen (atom #{})]
(for [[version base-types] versions+base-types
:let [descendants (base-types->descendants base-types)
not-yet-seen (set/difference descendants @already-seen)]
;; if all the descendants of any given version have already been seen, we can skip this clause altogether
:when (seq not-yet-seen)]
;; otherwise record the newly seen types and generate an appropriate clause
(do
(swap! already-seen set/union not-yet-seen)
[:and
[:< :fingerprint_version version]
[:in :base_type not-yet-seen]])))) |
Base clause to get fields for fingerprinting. When refingerprinting, run as is. When fingerprinting in analysis, only look for fields without a fingerprint or whose version can be updated. This clauses is added on by [[versions-clauses]]. | (def ^:private fields-to-fingerprint-base-clause
[:and
[:= :active true]
[:or
[:not (mdb.u/isa :semantic_type :type/PK)]
[:= :semantic_type nil]]
[:not-in :visibility_type ["retired" "sensitive"]]
[:not (mdb.u/isa :base_type :type/Structured)]]) |
Whether we are refingerprinting or doing the normal fingerprinting. Refingerprinting should get fields that already are analyzed and have fingerprints. | (def ^:dynamic *refingerprint?* false) |
(mu/defn ^:private honeysql-for-fields-that-need-fingerprint-updating :- [:map
[:where :any]]
"Return appropriate WHERE clause for all the Fields whose Fingerprint needs to be re-calculated."
([]
{:where (cond-> fields-to-fingerprint-base-clause
(not *refingerprint?*) (conj (cons :or (versions-clauses))))})
([table :- i/TableInstance]
(sql.helpers/where (honeysql-for-fields-that-need-fingerprint-updating)
[:= :table_id (u/the-id table)]))) | |
+----------------------------------------------------------------------------------------------------------------+ | FINGERPRINTING ALL FIELDS IN A TABLE | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn ^:private fields-to-fingerprint :- [:maybe [:sequential i/FieldInstance]]
"Return a sequences of Fields belonging to `table` for which we should generate (and save) fingerprints.
This should include NEW fields that are active and visible."
[table :- i/TableInstance]
(seq (t2/select Field
(honeysql-for-fields-that-need-fingerprint-updating table)))) | |
Generate and save fingerprints for all the Fields in TODO - | (mu/defn fingerprint-fields!
[table :- i/TableInstance]
(if-let [fields (fields-to-fingerprint table)]
(let [stats (sync-util/with-error-handling
(format "Error fingerprinting %s" (sync-util/name-for-logging table))
(fingerprint-table! table fields))]
(if (instance? Exception stats)
(empty-stats-map 0)
stats))
(empty-stats-map 0))) |
(def ^:private LogProgressFn [:=> [:cat :string [:schema i/TableInstance]] :any]) | |
Invokes | (mu/defn ^:private fingerprint-fields-for-db!*
([database :- i/DatabaseInstance
tables :- [:maybe [:sequential i/TableInstance]]
log-progress-fn :- LogProgressFn]
(fingerprint-fields-for-db!* database tables log-progress-fn (constantly true)))
;; TODO: Maybe the driver should have a function to tell you if it supports fingerprinting?
([database :- i/DatabaseInstance
tables :- [:maybe [:sequential i/TableInstance]]
log-progress-fn :- LogProgressFn
continue? :- [:=> [:cat ::FingerprintStats] :any]]
(qp.store/with-metadata-provider (u/the-id database)
(reduce (fn [acc table]
(log-progress-fn (if *refingerprint?* "refingerprint-fields" "fingerprint-fields") table)
(let [results (if (= :googleanalytics (:engine database))
(empty-stats-map 0)
(fingerprint-fields! table))
new-acc (merge-with + acc results)]
(if (continue? new-acc)
new-acc
(reduced new-acc))))
(empty-stats-map 0)
tables)))) |
Invokes [[fingerprint-fields!]] on every table in | (mu/defn fingerprint-fields-for-db! [database :- i/DatabaseInstance tables :- [:maybe [:sequential i/TableInstance]] log-progress-fn :- LogProgressFn] ;; TODO: Maybe the driver should have a function to tell you if it supports fingerprinting? (fingerprint-fields-for-db!* database tables log-progress-fn)) |
Maximum number of fields to refingerprint. Balance updating our fingerprinting values while not spending too much time in the db. | (def ^:private max-refingerprint-field-count 1000) |
Invokes [[fingeprint-fields!]] on every table in | (mu/defn refingerprint-fields-for-db!
[database :- i/DatabaseInstance
tables :- [:maybe [:sequential i/TableInstance]]
log-progress-fn :- LogProgressFn]
(binding [*refingerprint?* true]
(fingerprint-fields-for-db!* database
;; our rudimentary refingerprint strategy is to shuffle the tables and fingerprint
;; until we are over some threshold of fields
(shuffle tables)
log-progress-fn
(fn [stats-acc]
(< (:fingerprints-attempted stats-acc) max-refingerprint-field-count))))) |
Refingerprint a field | (mu/defn refingerprint-field
[field :- i/FieldInstance]
(let [table (field/table field)]
(fingerprint-table! table [field]))) |
Non-identifying fingerprinters for various field types. | (ns metabase.sync.analyze.fingerprint.fingerprinters (:require [bigml.histogram.core :as hist] [java-time.api :as t] [kixi.stats.core :as stats] [kixi.stats.math :as math] [medley.core :as m] [metabase.sync.analyze.classifiers.name :as classifiers.name] [metabase.sync.util :as sync-util] [metabase.util :as u] [metabase.util.date-2 :as u.date] [redux.core :as redux]) (:import (com.bigml.histogram Histogram) (com.clearspring.analytics.stream.cardinality HyperLogLogPlus) (java.time ZoneOffset) (java.time.chrono ChronoLocalDateTime ChronoZonedDateTime) (java.time.temporal Temporal))) |
(set! *warn-on-reflection* true) | |
Apply reducing functinons | (defn col-wise
[& rfs]
(fn
([] (mapv (fn [rf] (rf)) rfs))
([accs] (mapv (fn [rf acc] (rf (unreduced acc))) rfs accs))
([accs row]
(let [all-reduced? (volatile! true)
results (mapv (fn [rf acc x]
(if-not (reduced? acc)
(do (vreset! all-reduced? false)
(rf acc x))
acc))
rfs accs row)]
(if @all-reduced?
(reduced results)
results))))) |
Constantly return | (defn constant-fingerprinter
[init]
(fn
([] (reduced init))
([_] init)
([_ _] (reduced init)))) |
Transducer that sketches cardinality using HyperLogLog++. https://research.google.com/pubs/pub40671.html | (defn- cardinality ([] (HyperLogLogPlus. 14 25)) ([^HyperLogLogPlus acc] (.cardinality acc)) ([^HyperLogLogPlus acc x] (.offer acc x) acc)) |
Wrap each map value in try-catch block. | (defmacro robust-map
[& kvs]
`(hash-map ~@(apply concat (for [[k v] (partition 2 kvs)]
`[~k (try
~v
(catch Throwable _#))])))) |
(defmacro ^:private with-reduced-error
[msg & body]
`(let [result# (sync-util/with-error-handling ~msg ~@body)]
(if (instance? Throwable result#)
(reduced result#)
result#))) | |
Wrap | (defn with-error-handling
[rf msg]
(fn
([] (with-reduced-error msg (rf)))
([acc]
(unreduced
(if (or (reduced? acc)
(instance? Throwable acc))
acc
(with-reduced-error msg (rf acc)))))
([acc e] (with-reduced-error msg (rf acc e))))) |
Like | (defn robust-fuse
[kfs]
(redux/fuse (m/map-kv-vals (fn [k f]
(redux/post-complete
(with-error-handling f (format "Error reducing %s" (name k)))
(fn [result]
(when-not (instance? Throwable result)
result))))
kfs))) |
Return a fingerprinter transducer for a given field based on the field's type. | (defmulti fingerprinter
{:arglists '([field])}
(fn [{base-type :base_type, effective-type :effective_type, semantic-type :semantic_type, :keys [unit]}]
[(cond
(u.date/extract-units unit)
:type/Integer
;; for historical reasons the Temporal fingerprinter is still called `:type/DateTime` so anything that derives
;; from `Temporal` (such as DATEs and TIMEs) should still use the `:type/DateTime` fingerprinter
(isa? (or effective-type base-type) :type/Temporal)
:type/DateTime
:else
base-type)
(if (isa? semantic-type :Semantic/*)
semantic-type
:Semantic/*)
(if (isa? semantic-type :Relation/*)
semantic-type
:Relation/*)])) |
(def ^:private global-fingerprinter
(redux/post-complete
(robust-fuse {:distinct-count cardinality
:nil% (stats/share nil?)})
(partial hash-map :global))) | |
(defmethod fingerprinter :default [_] global-fingerprinter) | |
(defmethod fingerprinter [:type/* :Semantic/* :type/FK] [_] global-fingerprinter) | |
(defmethod fingerprinter [:type/* :Semantic/* :type/PK] [_] (constant-fingerprinter nil)) | |
(prefer-method fingerprinter [:type/* :Semantic/* :type/FK] [:type/Number :Semantic/* :Relation/*]) (prefer-method fingerprinter [:type/* :Semantic/* :type/FK] [:type/Text :Semantic/* :Relation/*]) (prefer-method fingerprinter [:type/* :Semantic/* :type/PK] [:type/Number :Semantic/* :Relation/*]) (prefer-method fingerprinter [:type/* :Semantic/* :type/PK] [:type/Text :Semantic/* :Relation/*]) (prefer-method fingerprinter [:type/DateTime :Semantic/* :Relation/*] [:type/* :Semantic/* :type/PK]) (prefer-method fingerprinter [:type/DateTime :Semantic/* :Relation/*] [:type/* :Semantic/* :type/FK]) | |
(defn- with-global-fingerprinter
[fingerprinter]
(redux/post-complete
(redux/juxt
fingerprinter
global-fingerprinter)
(fn [[type-fingerprint global-fingerprint]]
(merge global-fingerprint
type-fingerprint)))) | |
(defmacro ^:private deffingerprinter
[field-type transducer]
{:pre [(keyword? field-type)]}
(let [field-type [field-type :Semantic/* :Relation/*]]
`(defmethod fingerprinter ~field-type
[field#]
(with-error-handling
(with-global-fingerprinter
(redux/post-complete
~transducer
(fn [fingerprint#]
{:type {~(first field-type) fingerprint#}})))
(format "Error generating fingerprint for %s" (sync-util/name-for-logging field#)))))) | |
(declare ->temporal) | |
(defn- earliest
([] nil)
([acc]
(some-> acc u.date/format))
([acc t]
(if (and t acc (t/before? t acc))
t
(or acc t)))) | |
(defn- latest
([] nil)
([acc]
(some-> acc u.date/format))
([acc t]
(if (and t acc (t/after? t acc))
t
(or acc t)))) | |
Protocol for converting objects in resultset to a | (defprotocol ^:private ITemporalCoerceable
(->temporal ^java.time.temporal.Temporal [this]
"Coerce object to a `java.time` temporal type.")) |
(extend-protocol ITemporalCoerceable nil (->temporal [_] nil) String (->temporal [this] (->temporal (u.date/parse this))) Long (->temporal [this] (->temporal (t/instant this))) Integer (->temporal [this] (->temporal (t/instant this))) ChronoLocalDateTime (->temporal [this] (.toInstant this (ZoneOffset/UTC))) ChronoZonedDateTime (->temporal [this] (.toInstant this)) Temporal (->temporal [this] this) java.util.Date (->temporal [this] (t/instant this))) | |
(deffingerprinter :type/DateTime
((map ->temporal)
(robust-fuse {:earliest earliest
:latest latest}))) | |
Transducer that summarizes numerical data with a histogram. | (defn- histogram ([] (hist/create)) ([^Histogram histogram] histogram) ([^Histogram histogram x] (hist/insert-simple! histogram x))) |
(deffingerprinter :type/Number
(redux/post-complete
((filter u/real-number?) histogram)
(fn [h]
(let [{q1 0.25 q3 0.75} (hist/percentiles h 0.25 0.75)]
(robust-map
:min (hist/minimum h)
:max (hist/maximum h)
:avg (hist/mean h)
:sd (some-> h hist/variance math/sqrt)
:q1 q1
:q3 q3))))) | |
Is x a serialized JSON dictionary or array. Hueristically recognize maps and arrays. Uses the following strategies: - leading character {: assume valid JSON - leading character [: assume valid json unless its of the form [ident] where ident is not a boolean. | (defn- valid-serialized-json?
[x]
(u/ignore-exceptions
(when (and x (string? x))
(let [matcher (case (first x)
\[ (fn bracket-matcher [s]
(cond (re-find #"^\[\s*(?:true|false)" s) true
(re-find #"^\[\s*[a-zA-Z]" s) false
:else true))
\{ (constantly true)
(constantly false))]
(matcher x))))) |
(deffingerprinter :type/Text
((map str) ; we cast to str to support `field-literal` type overwriting:
; `[:field-literal "A_NUMBER" :type/Text]` (which still
; returns numbers in the result set)
(robust-fuse {:percent-json (stats/share valid-serialized-json?)
:percent-url (stats/share u/url?)
:percent-email (stats/share u/email?)
:percent-state (stats/share u/state?)
:average-length ((map count) stats/mean)}))) | |
Return a transducer for fingerprinting a resultset with fields | (defn fingerprint-fields
[fields]
(apply col-wise (for [field fields]
(fingerprinter
(cond-> field
;; Try to get a better guestimate of what we're dealing with on first sync
(every? nil? ((juxt :semantic_type :last_analyzed) field))
(assoc :semantic_type (classifiers.name/infer-semantic-type field))))))) |
Deeper statistical analysis of results. | (ns metabase.sync.analyze.fingerprint.insights (:require [java-time.api :as t] [kixi.stats.core :as stats] [kixi.stats.math :as math] [kixi.stats.protocols :as p] [medley.core :as m] [metabase.mbql.util :as mbql.u] [metabase.models.field :refer [Field]] [metabase.models.interface :as mi] [metabase.sync.analyze.fingerprint.fingerprinters :as fingerprinters] [metabase.sync.util :as sync-util] [metabase.util :as u] [metabase.util.date-2 :as u.date] [redux.core :as redux]) (:import (java.time Instant LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime ZonedDateTime))) |
(defn- last-n
[n]
(fn
([] [])
([acc]
(concat (repeat (- n (count acc)) nil) acc))
([acc x]
(if (< (count acc) n)
(conj acc x)
(conj (subvec acc 1) x))))) | |
Relative difference between | (defn change
[x2 x1]
(when (and x1 x2 (not (zero? x1)))
(let [x2 (double x2)
x1 (double x1)]
(cond
(every? neg? [x1 x2]) (change (- x1) (- x2))
(and (neg? x1) (pos? x2)) (- (change x1 x2))
(neg? x1) (- (change x2 (- x1)))
:else (/ (- x2 x1) x1))))) |
Transducer that samples a fixed number | (defn reservoir-sample
[n]
(fn
([] [[] 0])
([[reservoir c] x]
(let [c (inc c)
idx (rand-int c)]
(cond
(<= c n) [(conj reservoir x) c]
(< idx n) [(assoc reservoir idx x) c]
:else [reservoir c])))
([[reservoir _]] reservoir))) |
Given two functions: (fŷ input) and (fy input), returning the predicted and actual values of y respectively, calculates the mean absolute error of the estimate. https://en.wikipedia.org/wiki/Meanabsoluteerror | (defn mae
[fy-hat fy]
((map (fn [x]
(when x
(math/abs (- (fy x) (fy-hat x))))))
stats/mean)) |
(def ^:private trendline-function-families
;; http://mathworld.wolfram.com/LeastSquaresFitting.html
[{:x-link-fn identity
:y-link-fn identity
:model (fn [offset slope]
(fn [x]
(+ offset (* slope x))))
:formula (fn [offset slope]
[:+ offset [:* slope :x]])}
;; http://mathworld.wolfram.com/LeastSquaresFittingExponential.html
{:x-link-fn identity
:y-link-fn math/log
:model (fn [offset slope]
(fn [x]
(* (math/exp offset) (math/exp (* slope x)))))
:formula (fn [offset slope]
[:* (math/exp offset) [:exp [:* slope :x]]])}
;; http://mathworld.wolfram.com/LeastSquaresFittingLogarithmic.html
{:x-link-fn math/log
:y-link-fn identity
:model (fn [offset slope]
(fn [x]
(+ offset (* slope (math/log x)))))
:formula (fn [offset slope]
[:+ offset [:* slope [:log :x]]])}
;; http://mathworld.wolfram.com/LeastSquaresFittingPowerLaw.html
{:x-link-fn math/log
:y-link-fn math/log
:model (fn [offset slope]
(fn [x]
(* (math/exp offset) (math/pow x slope))))
:formula (fn [offset slope]
[:* (math/exp offset) [:pow :x slope]])}]) | |
(def ^:private ^:const ^Long validation-set-size 20) | |
Fit curves from | (defn- best-fit
[fx fy]
(redux/post-complete
(fingerprinters/robust-fuse
{:fits (->> (for [{:keys [x-link-fn y-link-fn formula model]} trendline-function-families]
(redux/post-complete
(stats/simple-linear-regression (comp (stats/somef x-link-fn) fx)
(comp (stats/somef y-link-fn) fy))
(fn [fit]
(let [[offset slope] (some-> fit p/parameters)]
(when (every? u/real-number? [offset slope])
{:model (model offset slope)
:formula (formula offset slope)})))))
(apply redux/juxt))
:validation-set ((keep (fn [row]
(let [x (fx row)
y (fy row)]
(when (and x y)
[x y]))))
(reservoir-sample validation-set-size))})
(fn [{:keys [validation-set fits]}]
(some->> fits
(remove nil?)
(map #(assoc % :mae (transduce identity
(mae (comp (:model %) first) second)
validation-set)))
(filter (comp u/real-number? :mae))
not-empty
(apply min-key :mae)
:formula)))) |
(defn- timeseries?
[{:keys [numbers datetimes others]}]
(and (pos? (count numbers))
(= (count datetimes) 1)
(empty? others))) | |
We downsize UNIX timestamps to lessen the chance of overflows and numerical instabilities. | (def ^Long ^:const ^:private ms-in-a-day (* 1000 60 60 24)) |
(defn- ms->day [dt] (/ dt ms-in-a-day)) | |
(defn- about= [a b] (< 0.9 (/ a b) 1.1)) | |
(def ^:private unit->duration
{:minute (/ 1 24 60)
:hour (/ 24)
:day 1
:week 7
:month 30.5
:quarter (* 30.4 3)
:year 365.1}) | |
(defn- valid-period?
[from to unit]
(when (and from to unit)
;; Make sure we work for both ascending and descending time series
(let [[from to] (sort [from to])]
(about= (- to from) (unit->duration unit))))) | |
(defn- infer-unit [from to] (m/find-first (partial valid-period? from to) (keys unit->duration))) | |
(defn- ->millis-from-epoch [t]
(when t
(condp instance? t
Instant (t/to-millis-from-epoch t)
OffsetDateTime (t/to-millis-from-epoch t)
ZonedDateTime (t/to-millis-from-epoch t)
LocalDate (->millis-from-epoch (t/offset-date-time t (t/local-time 0) (t/zone-offset 0)))
LocalDateTime (->millis-from-epoch (t/offset-date-time t (t/zone-offset 0)))
LocalTime (->millis-from-epoch (t/offset-date-time (t/local-date "1970-01-01") t (t/zone-offset 0)))
OffsetTime (->millis-from-epoch (t/offset-date-time (t/local-date "1970-01-01") t (t/zone-offset t)))))) | |
(defn- timeseries-insight
[{:keys [numbers datetimes]}]
(let [datetime (first datetimes)
x-position (:position datetime)
xfn #(some-> %
(nth x-position)
;; at this point in the pipeline, dates are still stings
fingerprinters/->temporal
->millis-from-epoch
ms->day)]
(fingerprinters/with-error-handling
(apply redux/juxt
(for [number-col numbers]
(redux/post-complete
(let [y-position (:position number-col)
yfn #(nth % y-position)]
((filter (comp u/real-number? yfn))
(redux/juxt ((map yfn) (last-n 2))
((map xfn) (last-n 2))
(stats/simple-linear-regression xfn yfn)
(best-fit xfn yfn))))
(fn [[[y-previous y-current] [x-previous x-current] fit best-fit-equation]]
(let [[offset slope] (some-> fit p/parameters)
unit (let [unit (some-> datetime :unit mbql.u/normalize-token)]
(if (or (nil? unit)
(= unit :default))
(infer-unit x-previous x-current)
unit))
show-change? (valid-period? x-previous x-current unit)]
(fingerprinters/robust-map
:last-value y-current
:previous-value (when show-change?
y-previous)
:last-change (when show-change?
(change y-current y-previous))
:slope slope
:offset offset
:best-fit best-fit-equation
:col (:name number-col)
:unit unit))))))
(format "Error generating timeseries insight keyed by: %s"
(sync-util/name-for-logging (mi/instance Field datetime)))))) | |
Based on the shape of returned data construct a transducer to statistically analyize data. | (defn insights
[cols]
(let [cols-by-type (->> cols
(map-indexed (fn [idx col]
(assoc col :position idx)))
(group-by (fn [{base-type :base_type
effective-type :effective_type
semantic-type :semantic_type
unit :unit}]
(cond
(isa? semantic-type :Relation/*) :others
(= unit :year) :datetimes
(u.date/extract-units unit) :numbers
(isa? (or effective-type base-type) :type/Temporal) :datetimes
(isa? base-type :type/Number) :numbers
:else :others))))]
(cond
(timeseries? cols-by-type) (timeseries-insight cols-by-type)
:else (fingerprinters/constant-fingerprinter nil)))) |
Analysis similar to what we do as part of the Sync process, but aimed at analyzing and introspecting query results. The current focus of this namespace is around column metadata from the results of a query. Going forward this is likely to extend beyond just metadata about columns but also about the query results as a whole and over time. | (ns metabase.sync.analyze.query-results
(:require
[metabase.lib.schema.expression.temporal
:as lib.schema.expression.temporal]
[metabase.lib.schema.id :as lib.schema.id]
[metabase.mbql.normalize :as mbql.normalize]
[metabase.mbql.predicates :as mbql.preds]
[metabase.mbql.schema :as mbql.s]
[metabase.sync.analyze.classifiers.name :as classifiers.name]
[metabase.sync.analyze.fingerprint.fingerprinters :as fingerprinters]
[metabase.sync.analyze.fingerprint.insights :as insights]
[metabase.sync.interface :as i]
[metabase.util :as u]
[metabase.util.i18n :as i18n]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.malli.registry :as mr]
[metabase.util.malli.schema :as ms]
[redux.core :as redux])) |
Schema for a valid datetime unit string like "default" or "minute-of-hour". | (def ^:private DateTimeUnitKeywordOrString
[:and
ms/KeywordOrString
[:fn
{:error/message "Valid field datetime unit keyword or string"}
#(mbql.preds/DateTimeUnit? (keyword %))]]) |
(mr/def ::MaybeUnnormalizedReference
[:fn
{:error/message "Field or aggregation reference as it comes in to the API"}
(fn [x]
(mr/validate mbql.s/Reference (mbql.normalize/normalize-tokens x)))]) | |
(mr/def ::ResultColumnMetadata
[:map
[:name :string]
[:display_name :string]
[:base_type ms/FieldTypeKeywordOrString]
[:description {:optional true} [:maybe :string]]
[:semantic_type {:optional true} [:maybe ms/FieldSemanticOrRelationTypeKeywordOrString]]
[:unit {:optional true} [:maybe DateTimeUnitKeywordOrString]]
[:fingerprint {:optional true} [:maybe i/Fingerprint]]
[:id {:optional true} [:maybe ::lib.schema.id/field]]
;; only optional because it's not present right away, but it should be present at the end.
[:field_ref {:optional true} [:ref ::MaybeUnnormalizedReference]]
;; the timezone in which the column was converted to using `:convert-timezone` expression
[:converted_timezone {:optional true} ::lib.schema.expression.temporal/timezone-id]]) | |
Result metadata for a single column | (def ^:private ResultColumnMetadata ;; this schema is used for both the API and the QP, so it should handle either normalized or unnormalized values. In ;; the QP, everything will be normalized. [:ref ::ResultColumnMetadata]) |
(mr/def ::ResultsMetadata (mu/with-api-error-message [:maybe [:sequential ResultColumnMetadata]] (i18n/deferred-tru "value must be an array of valid results column metadata maps."))) | |
Schema for valid values of the | (def ResultsMetadata [:ref ::ResultsMetadata]) |
(mu/defn ^:private maybe-infer-semantic-type :- ResultColumnMetadata
"Infer the semantic type and add it to the result metadata. If the inferred semantic type is nil, don't override the
semantic type with a nil semantic type"
[col]
(update
col
:semantic_type
(fn [original-value]
;; If we already know the semantic type, becouse it is stored, don't classify again, but try to refine semantic
;; type set upstream for aggregation cols (which come back as :type/Number).
(case original-value
(nil :type/Number) (classifiers.name/infer-semantic-type col)
original-value)))) | |
(mu/defn ^:private col->ResultColumnMetadata :- ResultColumnMetadata
"Make sure a `column` as it comes back from a driver's initial results metadata matches the schema for valid results
column metadata, adding placeholder values and removing nil keys."
[column]
;; HACK - not sure why we don't have display_name yet in some cases
(merge
{:base_type :type/*
:display_name (:name column)}
(u/select-non-nil-keys
column
[:name :display_name :description :base_type :semantic_type :unit :fingerprint :id :field_ref]))) | |
A reducing function that calculates what is ultimately returned as | (defn insights-rf
{:arglists '([metadata])}
[{:keys [cols]}]
(let [cols (for [col cols]
(try
(maybe-infer-semantic-type (col->ResultColumnMetadata col))
(catch Throwable e
(log/errorf e "Error generating insights for column: %s" col)
col)))]
(redux/post-complete
(redux/juxt
(apply fingerprinters/col-wise (for [{:keys [fingerprint], :as metadata} cols]
(if-not fingerprint
(fingerprinters/fingerprinter metadata)
(fingerprinters/constant-fingerprinter fingerprint))))
(insights/insights cols))
(fn [[fingerprints insights]]
{:metadata (map (fn [fingerprint metadata]
(if (instance? Throwable fingerprint)
metadata
(assoc metadata :fingerprint fingerprint)))
fingerprints
cols)
:insights (when-not (instance? Throwable insights)
insights)})))) |
Namespace with helpers for concurrent tasks in sync. Intended for quick, one-off tasks like re-syncing a table, fingerprinting a field, etc. | (ns metabase.sync.concurrent (:import (java.util.concurrent Callable Executors ExecutorService Future ThreadFactory))) |
(set! *warn-on-reflection* true) | |
(defonce ^:private thread-factory
(reify ThreadFactory
(newThread [_ r]
(doto (Thread. r)
(.setName "table sync worker")
(.setDaemon true))))) | |
(defonce ^:private executor (delay (Executors/newFixedThreadPool 1 ^ThreadFactory thread-factory))) | |
Submit a task to the single thread executor. This will attempt to serialize repeated requests to sync tables. It obviously cannot work across multiple instances. | (defn submit-task
^Future [^Callable f]
(let [task (bound-fn [] (f))]
(.submit ^ExecutorService @executor ^Callable task))) |
Fetch metadata functions fetch 'snapshots' of the schema for a data warehouse database, including information about tables, schemas, and fields, and their types. For example, with SQL databases, these functions use the JDBC DatabaseMetaData to get this information. | (ns metabase.sync.fetch-metadata (:require [metabase.driver :as driver] [metabase.driver.sql-jdbc.sync :as sql-jdbc.sync] [metabase.driver.util :as driver.u] [metabase.sync.interface :as i] [metabase.util.malli :as mu])) |
(mu/defn db-metadata :- i/DatabaseMetadata "Get basic Metadata about a `database` and its Tables. Doesn't include information about the Fields." [database :- i/DatabaseInstance] (driver/describe-database (driver.u/database->driver database) database)) | |
(mu/defn table-metadata :- i/TableMetadata "Get more detailed information about a `table` belonging to `database`. Includes information about the Fields." [database :- i/DatabaseInstance table :- i/TableInstance] (driver/describe-table (driver.u/database->driver database) database table)) | |
(mu/defn fk-metadata :- i/FKMetadata
"Get information about the foreign keys belonging to `table`."
[database :- i/DatabaseInstance
table :- i/TableInstance]
(let [driver (driver.u/database->driver database)]
(when (driver/database-supports? driver :foreign-keys database)
(driver/describe-table-fks driver database table)))) | |
(mu/defn nfc-metadata :- [:maybe [:set i/TableMetadataField]]
"Get information about the nested field column fields within `table`."
[database :- i/DatabaseInstance
table :- i/TableInstance]
(let [driver (driver.u/database->driver database)]
(when (driver/database-supports? driver :nested-field-columns database)
(sql-jdbc.sync/describe-nested-field-columns driver database table)))) | |
(mu/defn index-metadata :- [:maybe i/TableIndexMetadata] "Get information about the indexes belonging to `table`." [database :- i/DatabaseInstance table :- i/TableInstance] (driver/describe-table-indexes (driver.u/database->driver database) database table)) | |
Logic for updating FieldValues for fields in a database. | (ns metabase.sync.field-values (:require [java-time.api :as t] [metabase.db :as mdb] [metabase.driver.sql.query-processor :as sql.qp] [metabase.models.field :refer [Field]] [metabase.models.field-values :as field-values :refer [FieldValues]] [metabase.sync.interface :as i] [metabase.sync.util :as sync-util] [metabase.util :as u] [metabase.util.log :as log] [metabase.util.malli :as mu] [toucan2.core :as t2])) |
(mu/defn ^:private clear-field-values-for-field!
[field :- i/FieldInstance]
(when (t2/exists? FieldValues :field_id (u/the-id field))
(log/debug (format "Based on cardinality and/or type information, %s should no longer have field values.\n"
(sync-util/name-for-logging field))
"Deleting FieldValues...")
(field-values/clear-field-values-for-field! field)
::field-values/fv-deleted)) | |
(mu/defn ^:private update-field-values-for-field!
[field :- i/FieldInstance]
(log/debug (u/format-color 'green "Looking into updating FieldValues for %s" (sync-util/name-for-logging field)))
(let [field-values (t2/select-one FieldValues :field_id (u/the-id field) :type :full)]
(if (field-values/inactive? field-values)
(log/debugf "Field %s has not been used since %s. Skipping..."
(sync-util/name-for-logging field) (t/format "yyyy-MM-dd" (t/local-date-time (:last_used_at field-values))))
(field-values/create-or-update-full-field-values! field)))) | |
(defn- update-field-value-stats-count [counts-map result]
(if (instance? Exception result)
(update counts-map :errors inc)
(case result
::field-values/fv-created
(update counts-map :created inc)
::field-values/fv-updated
(update counts-map :updated inc)
::field-values/fv-deleted
(update counts-map :deleted inc)
counts-map))) | |
(defn- table->fields-to-scan [table] (t2/select Field :table_id (u/the-id table), :active true, :visibility_type "normal")) | |
Update the FieldValues for all Fields (as needed) for | (mu/defn update-field-values-for-table!
[table :- i/TableInstance]
(reduce (fn [fv-change-counts field]
(let [result (sync-util/with-error-handling (format "Error updating field values for %s" (sync-util/name-for-logging field))
(if (field-values/field-should-have-field-values? field)
(update-field-values-for-field! field)
(clear-field-values-for-field! field)))]
(update-field-value-stats-count fv-change-counts result)))
{:errors 0, :created 0, :updated 0, :deleted 0}
(table->fields-to-scan table))) |
(mu/defn ^:private update-field-values-for-database! [_database :- i/DatabaseInstance tables :- [:maybe [:sequential i/TableInstance]]] (apply merge-with + (map update-field-values-for-table! tables))) | |
(defn- update-field-values-summary [{:keys [created updated deleted errors]}]
(format "Updated %d field value sets, created %d, deleted %d with %d errors"
updated created deleted errors)) | |
(defn- delete-expired-advanced-field-values-summary [{:keys [deleted]}]
(format "Deleted %d expired advanced fieldvalues" deleted)) | |
(defn- delete-expired-advanced-field-values-for-field!
[field]
(sync-util/with-error-handling (format "Error deleting expired advanced field values for %s" (sync-util/name-for-logging field))
(let [conditions [:field_id (:id field)
:type [:in field-values/advanced-field-values-types]
:created_at [:< (sql.qp/add-interval-honeysql-form
(mdb/db-type)
:%now
(- (t/as field-values/advanced-field-values-max-age :days))
:day)]]
rows-count (apply t2/count FieldValues conditions)]
(apply t2/delete! FieldValues conditions)
rows-count))) | |
Delete all expired advanced FieldValues for a table and returns the number of deleted rows. For more info about advanced FieldValues, check the docs in [[metabase.models.field-values/field-values-types]] | (mu/defn delete-expired-advanced-field-values-for-table!
[table :- i/TableInstance]
(->> (table->fields-to-scan table)
(map delete-expired-advanced-field-values-for-field!)
(reduce +))) |
(mu/defn ^:private delete-expired-advanced-field-values-for-database!
[_database :- i/DatabaseInstance
tables :- [:maybe [:sequential i/TableInstance]]]
{:deleted (transduce (comp (map delete-expired-advanced-field-values-for-table!)
(map (fn [result]
(if (instance? Throwable result)
(throw result)
result))))
+
0
tables)}) | |
(defn- make-sync-field-values-steps
[tables]
[(sync-util/create-sync-step "delete-expired-advanced-field-values"
#(delete-expired-advanced-field-values-for-database! % tables)
delete-expired-advanced-field-values-summary)
(sync-util/create-sync-step "update-field-values"
#(update-field-values-for-database! % tables)
update-field-values-summary)]) | |
Update the advanced FieldValues (distinct values for categories and certain other fields that are shown
in widgets like filters) for the Tables in | (mu/defn update-field-values!
[database :- i/DatabaseInstance]
(sync-util/sync-operation :cache-field-values database (format "Cache field values in %s"
(sync-util/name-for-logging database))
(let [tables (sync-util/db->sync-tables database)]
(sync-util/run-sync-operation "field values scanning" database (make-sync-field-values-steps tables))))) |
Schemas and constants used by the sync code. | (ns metabase.sync.interface (:require [clojure.string :as str] [metabase.lib.schema.common :as lib.schema.common] [metabase.util.malli.registry :as mr] [metabase.util.malli.schema :as ms])) |
(mr/def ::DatabaseMetadataTable
[:map
[:name ::lib.schema.common/non-blank-string]
[:schema [:maybe ::lib.schema.common/non-blank-string]]
[:require-filter {:optional true} :boolean]
;; `:description` in this case should be a column/remark on the Table, if there is one.
[:description {:optional true} [:maybe :string]]]) | |
Schema for the expected output of | (def DatabaseMetadataTable [:ref ::DatabaseMetadataTable]) |
(mr/def ::DatabaseMetadata
[:map
[:tables [:set DatabaseMetadataTable]]
[:version {:optional true} [:maybe ::lib.schema.common/non-blank-string]]]) | |
Schema for the expected output of | (def DatabaseMetadata [:ref ::DatabaseMetadata]) |
(mr/def ::TableMetadataField
[:map
[:name ::lib.schema.common/non-blank-string]
[:database-type [:maybe ::lib.schema.common/non-blank-string]] ; blank if the Field is all NULL & untyped, i.e. in Mongo
[:base-type ::lib.schema.common/base-type]
[:database-position ::lib.schema.common/int-greater-than-or-equal-to-zero]
[:position {:optional true} ::lib.schema.common/int-greater-than-or-equal-to-zero]
[:semantic-type {:optional true} [:maybe ::lib.schema.common/semantic-or-relation-type]]
[:effective-type {:optional true} [:maybe ::lib.schema.common/base-type]]
[:coercion-strategy {:optional true} [:maybe ms/CoercionStrategy]]
[:field-comment {:optional true} [:maybe ::lib.schema.common/non-blank-string]]
[:pk? {:optional true} :boolean]
[:nested-fields {:optional true} [:set [:ref ::TableMetadataField]]]
[:json-unfolding {:optional true} :boolean]
[:nfc-path {:optional true} [:any]]
[:custom {:optional true} :map]
[:database-is-auto-increment {:optional true} :boolean]
;; nullable for databases that don't support field partition
[:database-partitioned {:optional true} [:maybe :boolean]]
[:database-required {:optional true} :boolean]]) | |
Schema for a given Field as provided in [[metabase.driver/describe-table]]. | (def TableMetadataField [:ref ::TableMetadataField]) |
(mr/def ::TableIndexMetadata
[:set
[:and
[:map
[:type [:enum :normal-column-index :nested-column-index]]]
[:multi {:dispatch :type}
[:normal-column-index [:map [:value ::lib.schema.common/non-blank-string]]]
[:nested-column-index [:map [:value [:sequential ::lib.schema.common/non-blank-string]]]]]]]) | |
Schema for a given Table as provided in [[metabase.driver/describe-table-indexes]]. | (def TableIndexMetadata [:ref ::TableIndexMetadata]) |
(mr/def ::TableMetadata
[:map
[:name ::lib.schema.common/non-blank-string]
[:schema [:maybe ::lib.schema.common/non-blank-string]]
[:fields [:set TableMetadataField]]
[:description {:optional true} [:maybe :string]]]) | |
Schema for the expected output of [[metabase.driver/describe-table]]. | (def TableMetadata [:ref ::TableMetadata]) |
Schema for the expected output of [[metabase.driver.sql-jdbc.sync/describe-nested-field-columns]]. not actually used; leaving here for now because it serves as documentation | (comment
(def NestedFCMetadata
[:maybe [:set TableMetadataField]])) |
(mr/def ::FKMetadataEntry
[:map
[:fk-column-name ::lib.schema.common/non-blank-string]
[:dest-table [:map
[:name ::lib.schema.common/non-blank-string]
[:schema [:maybe ::lib.schema.common/non-blank-string]]]]
[:dest-column-name ::lib.schema.common/non-blank-string]]) | |
Schema for an individual entry in | (def FKMetadataEntry [:ref ::FKMetadataEntry]) |
(mr/def ::FKMetadata [:maybe [:set FKMetadataEntry]]) | |
Schema for the expected output of | (def FKMetadata [:ref ::FKMetadata]) |
These schemas are provided purely as conveniences since adding | |
(mr/def ::no-kebab-case-keys
[:fn
{:error/message "Map should not contain any kebab-case keys"}
(fn [m]
(every? (fn [k]
(not (str/includes? k "-")))
(keys m)))]) | |
(mr/def ::DatabaseInstance [:and (ms/InstanceOf :model/Database) ::no-kebab-case-keys]) | |
Schema for a valid instance of a Metabase Database. | (def DatabaseInstance [:ref ::DatabaseInstance]) |
(mr/def ::TableInstance [:and (ms/InstanceOf :model/Table) ::no-kebab-case-keys]) | |
Schema for a valid instance of a Metabase Table. | (def TableInstance [:ref ::TableInstance]) |
(mr/def ::FieldInstance
[:and
[:and
(ms/InstanceOf :model/Field)
::no-kebab-case-keys]]) | |
Schema for a valid instance of a Metabase Field. | (def FieldInstance [:ref ::FieldInstance]) |
+----------------------------------------------------------------------------------------------------------------+ | SAMPLING & FINGERPRINTS | +----------------------------------------------------------------------------------------------------------------+ | |
(mr/def ::Percent
[:and
number?
[:fn
{:error/message "Valid percentage between (inclusive) 0 and 1."}
#(<= 0 % 1)]]) | |
Schema for something represting a percentage. A floating-point value between (inclusive) 0 and 1. | (def Percent [:ref ::Percent]) |
(mr/def ::GlobalFingerprint
[:map
[:distinct-count {:optional true} :int]
[:nil% {:optional true} [:maybe Percent]]]) | |
Fingerprint values that Fields of all types should have. | (def GlobalFingerprint [:ref ::GlobalFingerprint]) |
(mr/def ::NumberFingerprint
[:map
[:min {:optional true} [:maybe number?]]
[:max {:optional true} [:maybe number?]]
[:avg {:optional true} [:maybe number?]]
[:q1 {:optional true} [:maybe number?]]
[:q3 {:optional true} [:maybe number?]]
[:sd {:optional true} [:maybe number?]]]) | |
Schema for fingerprint information for Fields deriving from | (def NumberFingerprint [:ref ::NumberFingerprint]) |
(mr/def ::TextFingerprint
[:map
[:percent-json {:optional true} [:maybe Percent]]
[:percent-url {:optional true} [:maybe Percent]]
[:percent-email {:optional true} [:maybe Percent]]
[:percent-state {:optional true} [:maybe Percent]]
[:average-length {:optional true} [:maybe number?]]]) | |
Schema for fingerprint information for Fields deriving from | (def TextFingerprint [:ref ::TextFingerprint]) |
(mr/def ::TemporalFingerprint
[:map
[:earliest {:optional true} [:maybe :string]]
[:latest {:optional true} [:maybe :string]]]) | |
Schema for fingerprint information for Fields deriving from | (def TemporalFingerprint [:ref ::TemporalFingerprint]) |
(mr/def ::TypeSpecificFingerprint
[:and
[:map
[:type/Number {:optional true} NumberFingerprint]
[:type/Text {:optional true} TextFingerprint]
;; temporal fingerprints are keyed by `:type/DateTime` for historical reasons. `DateTime` used to be the parent of
;; all temporal MB types.
[:type/DateTime {:optional true} TemporalFingerprint]]
[:fn
{:error/message "Type-specific fingerprint with exactly one key"}
(fn [m]
(= 1 (count (keys m))))]]) | |
Schema for type-specific fingerprint information. | (def TypeSpecificFingerprint [:ref ::TypeSpecificFingerprint]) |
(mr/def ::Fingerprint
[:map
[:global {:optional true} GlobalFingerprint]
[:type {:optional true} TypeSpecificFingerprint]
[:experimental {:optional true} :map]]) | |
Schema for a Field 'fingerprint' generated as part of the analysis stage. Used to power the 'classification'
sub-stage of analysis. Stored as the | (def Fingerprint [:ref ::Fingerprint]) |
+----------------------------------------------------------------------------------------------------------------+ | FINGERPRINT VERSIONING | +----------------------------------------------------------------------------------------------------------------+ | |
Occasionally we want to update the schema of our Field fingerprints and add new logic to populate the additional keys. However, by default, analysis (which includes fingerprinting) only runs on NEW Fields, meaning EXISTING Fields won't get new fingerprints with the updated info. To work around this, we can use a versioning system. Fields whose Fingerprint's version is lower than the current
version should get updated during the next sync/analysis regardless of whether they are or are not new Fields.
However, this could be quite inefficient: if we add a new fingerprint field for Thus, our implementation below. Each new fingerprint version lists a set of types that should be upgraded to it. Our fingerprinting logic will calculate whether a fingerprint needs to be recalculated based on its version and the changes that have been made in subsequent versions. Only the Fields that would benefit from the new Fingerprint info need be re-fingerprinted. Thus, if Fingerprint v2 contains some new info for numeric Fields, only Fields that derive from | |
Map of fingerprint version to the set of Field base types that need to be upgraded to this version the next time we do analysis. The highest-numbered entry is considered the latest version of fingerprints. | (def ^:dynamic *fingerprint-version->types-that-should-be-re-fingerprinted*
{1 #{:type/*}
2 #{:type/Number}
3 #{:type/DateTime}
4 #{:type/*}
5 #{:type/Text}}) |
The newest (highest-numbered) version of our Field fingerprints. | (def ^:dynamic ^Long *latest-fingerprint-version* (apply max (keys *fingerprint-version->types-that-should-be-re-fingerprinted*))) |
Types and defaults for the syncing schedules used for the scheduled sync tasks. Has defaults for the two schedules
maps and some helper methods for turning those into appropriately named cron strings as stored in the
| (ns metabase.sync.schedules (:require [metabase.util.cron :as u.cron] [metabase.util.i18n :refer [deferred-tru]] [metabase.util.malli :as mu] [metabase.util.malli.registry :as mr])) |
Schema with values for a DB's schedules that can be put directly into the DB. | (def ^:private CronSchedulesMap
[:map
[:metadata_sync_schedule {:optional true} u.cron/CronScheduleString]
[:cache_field_values_schedule {:optional true} u.cron/CronScheduleString]]) |
(mr/def ::ExpandedSchedulesMap
(mu/with-api-error-message
[:map
{:error/message "Map of expanded schedule maps"}
[:cache_field_values {:optional true} u.cron/ScheduleMap]
[:metadata_sync {:optional true} u.cron/ScheduleMap]]
(deferred-tru "value must be a valid map of schedule maps for a DB."))) | |
Schema for the | (def ExpandedSchedulesMap [:ref ::ExpandedSchedulesMap]) |
(mu/defn schedule-map->cron-strings :- CronSchedulesMap
"Convert a map of `:schedules` as passed in by the frontend to a map of cron strings with the approriate keys for
Database. This map can then be merged directly inserted into the DB, or merged with a map of other columns to
insert/update."
[{:keys [metadata_sync cache_field_values]} :- ExpandedSchedulesMap]
(cond-> {}
metadata_sync (assoc :metadata_sync_schedule (u.cron/schedule-map->cron-string metadata_sync))
cache_field_values (assoc :cache_field_values_schedule (u.cron/schedule-map->cron-string cache_field_values)))) | |
Schedule map for once an hour at a random minute of the hour. | (defn randomly-once-an-hour
[]
;; prevent zeros and 50s which would appear as non-random choices
(let [choices (into [] (remove #{0 50}) (range 60))]
{:schedule_minute (rand-nth choices)
:schedule_type "hourly"})) |
Schedule map for once a day at a random hour of the day. | (defn randomly-once-a-day
[]
;; prevent zeros which would appear as non-random
{:schedule_hour (inc (rand-int 23))
:schedule_type "daily"}) |
Default schedule maps for caching field values and sync. Defaults to | (defn default-randomized-schedule
[]
{:cache_field_values (randomly-once-a-day)
:metadata_sync (randomly-once-an-hour)}) |
Default two because application and db each have defaults | (def default-cache-field-values-schedule-cron-strings
#{"0 0 0 * * ? *" "0 50 0 * * ? *"}) |
Default | (def default-metadata-sync-schedule-cron-strings
#{"0 0 * * * ? *" "0 50 * * * ? *"}) |
Adds sync schedule defaults to a map of schedule-maps. | (defn scheduling
[{:keys [cache_field_values metadata_sync] :as _schedules}]
{:cache_field_values (or cache_field_values (randomly-once-a-day))
:metadata_sync (or metadata_sync (randomly-once-an-hour))}) |
Logic responsible for syncing the metadata for an entire database. Delegates to different subtasks:
| (ns metabase.sync.sync-metadata (:require [metabase.models.table :as table] [metabase.sync.fetch-metadata :as fetch-metadata] [metabase.sync.interface :as i] [metabase.sync.sync-metadata.dbms-version :as sync-dbms-ver] [metabase.sync.sync-metadata.fields :as sync-fields] [metabase.sync.sync-metadata.fks :as sync-fks] [metabase.sync.sync-metadata.indexes :as sync-indexes] [metabase.sync.sync-metadata.metabase-metadata :as metabase-metadata] [metabase.sync.sync-metadata.sync-table-privileges :as sync-table-privileges] [metabase.sync.sync-metadata.sync-timezone :as sync-tz] [metabase.sync.sync-metadata.tables :as sync-tables] [metabase.sync.util :as sync-util] [metabase.util :as u] [metabase.util.malli :as mu])) |
(defn- sync-dbms-version-summary [{:keys [version] :as _step-info}]
(if version
(format "Found DBMS version %s" version)
"Could not determine DBMS version")) | |
(defn- sync-fields-summary [{:keys [total-fields updated-fields] :as _step-info}]
(format "Total number of fields sync''d %d, number of fields updated %d"
total-fields updated-fields)) | |
(defn- sync-tables-summary [{:keys [total-tables updated-tables] :as _step-info}]
(format "Total number of tables sync''d %d, number of tables updated %d"
total-tables updated-tables)) | |
(defn- sync-timezone-summary [{:keys [timezone-id]}]
(format "Found timezone id %s" timezone-id)) | |
(defn- sync-fks-summary [{:keys [total-fks updated-fks total-failed]}]
(format "Total number of foreign keys sync''d %d, %d updated and %d tables failed to update"
total-fks updated-fks total-failed)) | |
(defn- sync-indexes-summary [{:keys [total-indexes added-indexes removed-indexes]}]
(format "Total number of indexes sync''d %d, %d added and %d removed"
total-indexes added-indexes removed-indexes)) | |
(defn- make-sync-steps [db-metadata] [(sync-util/create-sync-step "sync-dbms-version" sync-dbms-ver/sync-dbms-version! sync-dbms-version-summary) (sync-util/create-sync-step "sync-timezone" sync-tz/sync-timezone! sync-timezone-summary) ;; Make sure the relevant table models are up-to-date (sync-util/create-sync-step "sync-tables" #(sync-tables/sync-tables-and-database! % db-metadata) sync-tables-summary) ;; Now for each table, sync the fields (sync-util/create-sync-step "sync-fields" sync-fields/sync-fields! sync-fields-summary) ;; Now for each table, sync the FKS. This has to be done after syncing all the fields to make sure target fields exist (sync-util/create-sync-step "sync-fks" sync-fks/sync-fks! sync-fks-summary) ;; Sync index info if the database supports it (sync-util/create-sync-step "sync-indexes" sync-indexes/maybe-sync-indexes! sync-indexes-summary) ;; finally, sync the metadata metadata table if it exists. (sync-util/create-sync-step "sync-metabase-metadata" #(metabase-metadata/sync-metabase-metadata! % db-metadata)) ;; Now sync the table privileges (sync-util/create-sync-step "sync-table-privileges" sync-table-privileges/sync-table-privileges!)]) | |
Sync the metadata for a Metabase | (mu/defn sync-db-metadata!
[database :- i/DatabaseInstance]
(sync-util/sync-operation :sync-metadata database (format "Sync metadata for %s" (sync-util/name-for-logging database))
(let [db-metadata (fetch-metadata/db-metadata database)]
(u/prog1 (sync-util/run-sync-operation "sync" database (make-sync-steps db-metadata))
(if (some sync-util/abandon-sync? (map second (:steps <>)))
(sync-util/set-initial-database-sync-aborted! database)
(sync-util/set-initial-database-sync-complete! database)))))) |
Sync the metadata for an individual | (mu/defn sync-table-metadata!
[table :- i/TableInstance]
(let [database (table/database table)]
(sync-fields/sync-fields-for-table! database table)
(sync-fks/sync-fks-for-table! database table)
(sync-indexes/maybe-sync-indexes-for-table! database table))) |
(ns metabase.sync.sync-metadata.dbms-version (:require [metabase.driver :as driver] [metabase.driver.util :as driver.u] [metabase.models.database :refer [Database]] [metabase.sync.interface :as i] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) | |
Schema for the expected output of [[sync-dbms-version!]]. | (def DBMSVersion [:map [:version ms/NonBlankString]]) |
(mu/defn sync-dbms-version! :- [:maybe DBMSVersion]
"Get the DBMS version as provided by the driver and save it in the Database."
[database :- i/DatabaseInstance]
(let [driver (driver.u/database->driver database)
version (driver/dbms-version driver database)]
(when (not= version (:dbms_version database))
(t2/update! Database (:id database) {:dbms_version version}))
version)) | |
Logic for updating Metabase Field models from metadata fetched from a physical DB. The basic idea here is to look at the metadata we get from calling
A note on terminology used in
Other notes:
| (ns metabase.sync.sync-metadata.fields (:require [metabase.models.table :as table] [metabase.sync.interface :as i] [metabase.sync.sync-metadata.fields.fetch-metadata :as fetch-metadata] [metabase.sync.sync-metadata.fields.sync-instances :as sync-instances] [metabase.sync.sync-metadata.fields.sync-metadata :as sync-metadata] [metabase.sync.util :as sync-util] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms])) |
+----------------------------------------------------------------------------------------------------------------+ | PUTTING IT ALL TOGETHER | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn ^:private sync-and-update! :- ms/IntGreaterThanOrEqualToZero
"Sync Field instances (i.e., rows in the Field table in the Metabase application DB) for a Table, and update metadata
properties (e.g. base type and comment/remark) as needed. Returns number of Fields synced."
[table :- i/TableInstance
db-metadata :- [:set i/TableMetadataField]]
(+ (sync-instances/sync-instances! table db-metadata (fetch-metadata/our-metadata table))
;; Now that tables are synced and fields created as needed make sure field properties are in sync.
;; Re-fetch our metadata because there might be somethings that have changed after calling
;; `sync-instances`
(sync-metadata/update-metadata! table db-metadata (fetch-metadata/our-metadata table)))) | |
Sync the Fields in the Metabase application database for a specific | (mu/defn sync-fields-for-table!
([table :- i/TableInstance]
(sync-fields-for-table! (table/database table) table))
([database :- i/DatabaseInstance
table :- i/TableInstance]
(sync-util/with-error-handling (format "Error syncing Fields for Table ''%s''" (sync-util/name-for-logging table))
(let [db-metadata (fetch-metadata/db-metadata database table)]
{:total-fields (count db-metadata)
:updated-fields (sync-and-update! table db-metadata)})))) |
(mu/defn sync-fields! :- [:maybe
[:map
[:updated-fields ms/IntGreaterThanOrEqualToZero]
[:total-fields ms/IntGreaterThanOrEqualToZero]]]
"Sync the Fields in the Metabase application database for all the Tables in a `database`."
[database :- i/DatabaseInstance]
(->> database
sync-util/db->sync-tables
(map (partial sync-fields-for-table! database))
(remove (partial instance? Throwable))
(apply merge-with +))) | |
Schemas and functions shared by different | (ns metabase.sync.sync-metadata.fields.common (:require [metabase.lib.schema.id :as lib.schema.id] [metabase.sync.interface :as i] [metabase.sync.util :as sync-util] [metabase.util :as u] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.registry :as mr] [metabase.util.malli.schema :as ms])) |
Schema for the | (def ParentID [:maybe ::lib.schema.id/field]) |
(mr/def ::TableMetadataFieldWithID
[:merge
i/TableMetadataField
[:map
[:id ::lib.schema.id/field]
[:nested-fields {:optional true} [:set [:ref ::TableMetadataFieldWithID]]]]]) | |
Schema for | (def TableMetadataFieldWithID [:ref ::TableMetadataFieldWithID]) |
(mr/def ::TableMetadataFieldWithOptionalID
[:merge
[:ref ::TableMetadataFieldWithID]
[:map
[:id {:optional true} ::lib.schema.id/field]
[:nested-fields {:optional true} [:set [:ref ::TableMetadataFieldWithOptionalID]]]]]) | |
Schema for either | (def TableMetadataFieldWithOptionalID [:ref ::TableMetadataFieldWithOptionalID]) |
(mu/defn field-metadata-name-for-logging :- :string
"Return a 'name for logging' for a map that conforms to the `TableMetadataField` schema.
(field-metadata-name-for-logging table field-metadata) ; -> \"Table 'venues' Field 'name'\
[table :- i/TableInstance field-metadata :- TableMetadataFieldWithOptionalID]
(format "%s %s '%s'" (sync-util/name-for-logging table) "Field" (:name field-metadata))) | |
Return the lower-cased 'canonical' name that should be used to uniquely identify | (defn canonical-name [field] (u/lower-case-en (:name field))) |
(mu/defn semantic-type :- [:maybe ms/FieldSemanticOrRelationType]
"Determine a the appropriate `semantic-type` for a Field with `field-metadata`."
[field-metadata :- [:maybe i/TableMetadataField]]
(and field-metadata
(or (:semantic-type field-metadata)
(when (:pk? field-metadata) :type/PK)))) | |
(mu/defn matching-field-metadata :- [:maybe TableMetadataFieldWithOptionalID]
"Find Metadata that matches `field-metadata` from a set of `other-metadata`, if any exists. Useful for finding the
corresponding Metabase Field for field metadata from the DB, or vice versa. Will prefer exact matches."
[field-metadata :- TableMetadataFieldWithOptionalID
other-metadata :- [:set TableMetadataFieldWithOptionalID]]
(let [matches (keep
(fn [other-field-metadata]
(when (= (canonical-name field-metadata)
(canonical-name other-field-metadata))
other-field-metadata))
other-metadata)]
(case (count matches)
0
nil
1
(first matches)
(if-let [exact (some (fn [match]
(when (= (:name field-metadata) (:name match))
match))
matches)]
exact
(do
(log/warn "Found multiple matching field metadata for:" (:name field-metadata) (map :name matches))
(first matches)))))) | |
Logic for constructing a map of metadata from the Metabase application database that matches the form of DB metadata
about Fields in a Table, and for fetching the DB metadata itself. This metadata is used by the logic in other
| (ns metabase.sync.sync-metadata.fields.fetch-metadata (:require [clojure.set :as set] [medley.core :as m] [metabase.driver :as driver] [metabase.models.table :as table] [metabase.sync.fetch-metadata :as fetch-metadata] [metabase.sync.interface :as i] [metabase.sync.sync-metadata.fields.common :as common] [metabase.util :as u] [metabase.util.malli :as mu] [toucan2.core :as t2])) |
+----------------------------------------------------------------------------------------------------------------+ | FETCHING OUR CURRENT METADATA | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn ^:private fields->parent-id->fields :- [:map-of common/ParentID [:set common/TableMetadataFieldWithID]]
[fields :- [:maybe [:sequential i/FieldInstance]]]
(->> (for [field fields]
{:parent-id (:parent_id field)
:id (:id field)
:name (:name field)
:database-type (:database_type field)
:effective-type (:effective_type field)
:coercion-strategy (:coercion_strategy field)
:base-type (:base_type field)
:semantic-type (:semantic_type field)
:pk? (isa? (:semantic_type field) :type/PK)
:field-comment (:description field)
:json-unfolding (:json_unfolding field)
:database-is-auto-increment (:database_is_auto_increment field)
:position (:position field)
:database-position (:database_position field)
:database-partitioned (:database_partitioned field)
:database-required (:database_required field)})
;; make a map of parent-id -> set of child Fields
(group-by :parent-id)
;; remove the parent ID because the Metadata from `describe-table` won't have it. Save the results as a set
(m/map-vals (fn [fields]
(set (for [field fields]
(dissoc field :parent-id))))))) | |
(mu/defn ^:private add-nested-fields :- common/TableMetadataFieldWithID
"Recursively add entries for any nested-fields to `field`."
[metabase-field :- common/TableMetadataFieldWithID
parent-id->fields :- [:map-of common/ParentID [:set common/TableMetadataFieldWithID]]]
(let [nested-fields (get parent-id->fields (u/the-id metabase-field))]
(if-not (seq nested-fields)
metabase-field
(assoc metabase-field :nested-fields (set (for [nested-field nested-fields]
(add-nested-fields nested-field parent-id->fields))))))) | |
(mu/defn fields->our-metadata :- [:set common/TableMetadataFieldWithID]
"Given a sequence of Metabase Fields, format them and return them in a hierachy so the format matches the one
`db-metadata` comes back in."
([fields :- [:maybe [:sequential i/FieldInstance]]]
(fields->our-metadata fields nil))
([fields :- [:maybe [:sequential i/FieldInstance]], top-level-parent-id :- common/ParentID]
(let [parent-id->fields (fields->parent-id->fields fields)]
;; get all the top-level fields, then call `add-nested-fields` to recursively add the fields
(set (for [metabase-field (get parent-id->fields top-level-parent-id)]
(add-nested-fields metabase-field parent-id->fields)))))) | |
(mu/defn ^:private table->fields :- [:maybe [:sequential i/FieldInstance]]
"Fetch active Fields from the Metabase application database for a given `table`."
[table :- i/TableInstance]
(t2/select [:model/Field :name :database_type :base_type :effective_type :coercion_strategy :semantic_type
:parent_id :id :description :database_position :nfc_path :database_is_auto_increment :database_required
:database_partitioned :json_unfolding :position]
:table_id (u/the-id table)
:active true
{:order-by table/field-order-rule})) | |
(mu/defn our-metadata :- [:set common/TableMetadataFieldWithID] "Return information we have about Fields for a `table` in the application database in (almost) exactly the same `TableMetadataField` format returned by `describe-table`." [table :- i/TableInstance] (-> table table->fields fields->our-metadata)) | |
+----------------------------------------------------------------------------------------------------------------+ | FETCHING METADATA FROM CONNECTED DB | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn db-metadata :- [:set i/TableMetadataField]
"Fetch metadata about Fields belonging to a given `table` directly from an external database by calling its driver's
implementation of `describe-table`."
[database :- i/DatabaseInstance
table :- i/TableInstance]
(cond-> (:fields (fetch-metadata/table-metadata database table))
(driver/database-supports? (:engine database) :nested-field-columns database)
(set/union (fetch-metadata/nfc-metadata database table)))) | |
Logic for syncing the instances of All nested Fields recursion is handled in one place, by the main entrypoint ( | (ns metabase.sync.sync-metadata.fields.sync-instances (:require [medley.core :as m] [metabase.lib.schema.id :as lib.schema.id] [metabase.models.field :as field :refer [Field]] [metabase.models.humanization :as humanization] [metabase.sync.interface :as i] [metabase.sync.sync-metadata.fields.common :as common] [metabase.sync.sync-metadata.fields.fetch-metadata :as fetch-metadata] [metabase.sync.util :as sync-util] [metabase.util :as u] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
+----------------------------------------------------------------------------------------------------------------+ | CREATING / REACTIVATING FIELDS | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn ^:private matching-inactive-fields :- [:maybe [:sequential i/FieldInstance]]
"Return inactive Metabase Fields that match any of the Fields described by `new-field-metadatas`, if any such Fields
exist."
[table :- i/TableInstance
new-field-metadatas :- [:maybe [:sequential i/TableMetadataField]]
parent-id :- common/ParentID]
(when (seq new-field-metadatas)
(t2/select Field
:table_id (u/the-id table)
:%lower.name [:in (map common/canonical-name new-field-metadatas)]
:parent_id parent-id
:active false))) | |
(mu/defn ^:private insert-new-fields! :- [:maybe [:sequential ::lib.schema.id/field]]
"Insert new Field rows for for all the Fields described by `new-field-metadatas`. Returns IDs of newly inserted
Fields."
[table :- i/TableInstance
new-field-metadatas :- [:maybe [:sequential i/TableMetadataField]]
parent-id :- common/ParentID]
(when (seq new-field-metadatas)
(t2/insert-returning-pks! Field
(for [{:keys [base-type coercion-strategy database-is-auto-increment database-partitioned database-position
database-required database-type effective-type field-comment json-unfolding nfc-path visibility-type]
field-name :name :as field} new-field-metadatas]
(do
(when (and effective-type
base-type
(not= effective-type base-type)
(nil? coercion-strategy))
(log/warn (u/format-color 'red
(str
"WARNING: Field `%s`: effective type `%s` provided but no coercion strategy provided."
" Using base-type: `%s`")
field-name
effective-type
base-type)))
{:table_id (u/the-id table)
:name field-name
:display_name (humanization/name->human-readable-name field-name)
:database_type (or database-type "NULL") ; placeholder for Fields w/ no type info (e.g. Mongo) & all NULL
:base_type base-type
;; todo test this?
:effective_type (if (and effective-type coercion-strategy) effective-type base-type)
:coercion_strategy (when effective-type coercion-strategy)
:semantic_type (common/semantic-type field)
:parent_id parent-id
:nfc_path nfc-path
:description field-comment
:position database-position
:database_position database-position
:json_unfolding (or json-unfolding false)
:database_is_auto_increment (or database-is-auto-increment false)
:database_required (or database-required false)
:database_partitioned database-partitioned ;; nullable for database that doesn't support partitioned fields
:visibility_type (or visibility-type :normal)}))))) | |
(mu/defn ^:private create-or-reactivate-fields! :- [:maybe [:sequential i/FieldInstance]]
"Create (or reactivate) Metabase Field object(s) for any Fields in `new-field-metadatas`. Does *NOT* recursively
handle nested Fields."
[table :- i/TableInstance
new-field-metadatas :- [:maybe [:sequential i/TableMetadataField]]
parent-id :- common/ParentID]
(let [fields-to-reactivate (matching-inactive-fields table new-field-metadatas parent-id)]
;; if the fields already exist but were just marked inactive then reäctivate them
(when (seq fields-to-reactivate)
(t2/update! Field {:id [:in (map u/the-id fields-to-reactivate)]}
{:active true}))
(let [reactivated? (comp (set (map common/canonical-name fields-to-reactivate))
common/canonical-name)
;; If we reactivated the fields, no need to insert them; insert new rows for any that weren't reactivated
new-field-ids (insert-new-fields! table (remove reactivated? new-field-metadatas) parent-id)]
;; now return the newly created or reactivated Fields
(when-let [new-and-updated-fields (seq (map u/the-id (concat fields-to-reactivate new-field-ids)))]
(t2/select Field :id [:in new-and-updated-fields]))))) | |
+----------------------------------------------------------------------------------------------------------------+ | SYNCING INSTANCES OF 'ACTIVE' FIELDS (FIELDS IN DB METADATA) | +----------------------------------------------------------------------------------------------------------------+ | |
Schema for the value returned by | (def ^:private Updates [:map [:num-updates ms/IntGreaterThanOrEqualToZero] [:our-metadata [:set common/TableMetadataFieldWithID]]]) |
(mu/defn ^:private sync-active-instances! :- Updates
"Sync instances of `Field` in the application database with 'active' Fields in the DB being synced (i.e., ones that
are returned as part of the `db-metadata`). Creates or reactivates Fields as needed. Returns number of Fields
synced and updated `our-metadata` including the new Fields and their IDs."
[table :- i/TableInstance
db-metadata :- [:set i/TableMetadataField]
our-metadata :- [:set common/TableMetadataFieldWithID]
parent-id :- common/ParentID]
(let [known-fields (m/index-by common/canonical-name our-metadata)
our-metadata (atom our-metadata)]
{:num-updates
;; Field sync logic below is broken out into chunks of 1000 fields for huge star schemas or other situations
;; where we don't want to be updating way too many rows at once
(sync-util/sum-for [db-field-chunk (partition-all 1000 db-metadata)]
(sync-util/with-error-handling (format "Error checking if Fields %s need to be created or reactivated"
(pr-str (map :name db-field-chunk)))
(let [known-field? (comp known-fields common/canonical-name)
new-fields (remove known-field? db-field-chunk)
new-field-instances (create-or-reactivate-fields! table new-fields parent-id)]
;; save any updates to `our-metadata`
(swap! our-metadata into (fetch-metadata/fields->our-metadata new-field-instances parent-id))
;; now return count of rows updated
(count new-fields))))
:our-metadata
@our-metadata})) | |
+----------------------------------------------------------------------------------------------------------------+ | "RETIRING" INACTIVE FIELDS | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn ^:private retire-field! :- [:maybe [:= 1]]
"Mark an `old-field` belonging to `table` as inactive if corresponding Field object exists. Does *NOT* recurse over
nested Fields. Returns `1` if a Field was marked inactive, `nil` otherwise."
[table :- i/TableInstance
metabase-field :- common/TableMetadataFieldWithID]
(log/infof "Marking Field ''%s'' as inactive." (common/field-metadata-name-for-logging table metabase-field))
(when (pos? (t2/update! Field (u/the-id metabase-field) {:active false}))
1)) | |
(mu/defn ^:private retire-fields! :- ms/IntGreaterThanOrEqualToZero
"Mark inactive any Fields in the application database that are no longer present in the DB being synced. These
Fields are ones that are in `our-metadata`, but not in `db-metadata`. Does *NOT* recurse over nested Fields.
Returns `1` if a Field was marked inactive."
[table :- i/TableInstance
db-metadata :- [:set i/TableMetadataField]
our-metadata :- [:set common/TableMetadataFieldWithID]]
;; retire all the Fields not present in `db-metadata`, and count how many rows were actually affected
(sync-util/sum-for [metabase-field our-metadata
:when (not (common/matching-field-metadata metabase-field db-metadata))]
(sync-util/with-error-handling (format "Error retiring %s"
(common/field-metadata-name-for-logging table metabase-field))
(retire-field! table metabase-field)))) | |
+----------------------------------------------------------------------------------------------------------------+ | HIGH-LEVEL INSTANCE SYNCING LOGIC (CREATING/REACTIVATING/RETIRING/UPDATING) | +----------------------------------------------------------------------------------------------------------------+ | |
(declare sync-instances!) | |
(mu/defn ^:private sync-nested-fields-of-one-field! :- [:maybe ms/IntGreaterThanOrEqualToZero]
"Recursively sync Field instances (i.e., rows in application DB) for nested Fields of a single Field, one or both
`field-metadata` (from synced DB) and `metabase-field` (from application DB)."
[table :- i/TableInstance
field-metadata :- [:maybe i/TableMetadataField]
metabase-field :- [:maybe common/TableMetadataFieldWithID]]
(let [nested-fields-metadata (:nested-fields field-metadata)
metabase-nested-fields (:nested-fields metabase-field)]
(when (or (seq nested-fields-metadata)
(seq metabase-nested-fields))
(sync-instances!
table
(set nested-fields-metadata)
(set metabase-nested-fields)
(some-> metabase-field u/the-id))))) | |
(mu/defn ^:private sync-nested-field-instances! :- [:maybe ms/IntGreaterThanOrEqualToZero]
"Recursively sync Field instances (i.e., rows in application DB) for *all* the nested Fields of all Fields in
`db-metadata` and `our-metadata`.
Not for the flattened nested fields for JSON columns in normal RDBMSes (nested field columns)"
[table :- i/TableInstance
db-metadata :- [:set i/TableMetadataField]
our-metadata :- [:set common/TableMetadataFieldWithID]]
(let [name->field-metadata (m/index-by common/canonical-name db-metadata)
name->metabase-field (m/index-by common/canonical-name our-metadata)
all-field-names (set (concat (keys name->field-metadata)
(keys name->metabase-field)))]
(sync-util/sum-for [field-name all-field-names
:let [field-metadata (get name->field-metadata field-name)
metabase-field (get name->metabase-field field-name)]]
(sync-nested-fields-of-one-field! table field-metadata metabase-field)))) | |
(mu/defn sync-instances! :- ms/IntGreaterThanOrEqualToZero
"Sync rows in the Field table with `db-metadata` describing the current schema of the Table currently being synced,
creating Field objects or marking them active/inactive as needed."
([table :- i/TableInstance
db-metadata :- [:set i/TableMetadataField]
our-metadata :- [:set common/TableMetadataFieldWithID]]
(sync-instances! table db-metadata our-metadata nil))
([table :- i/TableInstance
db-metadata :- [:set i/TableMetadataField]
our-metadata :- [:set common/TableMetadataFieldWithID]
parent-id :- common/ParentID]
;; syncing the active instances makes important changes to `our-metadata` that need to be passed to recursive
;; calls, such as adding new Fields or making inactive ones active again. Keep updated version returned by
;; `sync-active-instances!`
(let [{:keys [num-updates our-metadata]} (sync-active-instances! table db-metadata our-metadata parent-id)]
(+ num-updates
(retire-fields! table db-metadata our-metadata)
(sync-nested-field-instances! table db-metadata our-metadata))))) | |
Logic for updating metadata properties of | (ns metabase.sync.sync-metadata.fields.sync-metadata (:require [clojure.string :as str] [metabase.models.field :as field :refer [Field]] [metabase.sync.interface :as i] [metabase.sync.sync-metadata.fields.common :as common] [metabase.sync.util :as sync-util] [metabase.util :as u] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
(mu/defn ^:private update-field-metadata-if-needed! :- [:enum 0 1]
"Update the metadata for a Metabase Field as needed if any of the info coming back from the DB has changed. Syncs
base type, database type, semantic type, and comments/remarks; returns `1` if the Field was updated; `0` otherwise."
[table :- i/TableInstance
field-metadata :- i/TableMetadataField
metabase-field :- common/TableMetadataFieldWithID]
(let [{old-database-type :database-type
old-base-type :base-type
old-field-comment :field-comment
old-semantic-type :semantic-type
old-database-position :database-position
old-position :position
old-database-name :name
old-database-is-auto-increment :database-is-auto-increment
old-db-partitioned :database-partitioned
old-db-required :database-required} metabase-field
{new-database-type :database-type
new-base-type :base-type
new-field-comment :field-comment
new-database-position :database-position
new-database-name :name
new-database-is-auto-increment :database-is-auto-increment
new-db-partitioned :database-partitioned
new-db-required :database-required} field-metadata
new-database-is-auto-increment (boolean new-database-is-auto-increment)
new-db-required (boolean new-db-required)
new-database-type (or new-database-type "NULL")
new-semantic-type (common/semantic-type field-metadata)
new-db-type?
(not= old-database-type new-database-type)
new-base-type?
(not= old-base-type new-base-type)
;; only sync comment if old value was blank so we don't overwrite user-set values
new-semantic-type?
(and (nil? old-semantic-type)
(not= old-semantic-type new-semantic-type))
new-comment?
(and (str/blank? old-field-comment)
(not (str/blank? new-field-comment)))
new-database-position?
(not= old-database-position new-database-position)
;; these fields are paired by by metabase.sync.sync-metadata.fields.common/canonical-name, so if they are
;; different they have the same canonical representation (lower-casing at the moment).
new-name? (not= old-database-name new-database-name)
new-db-auto-incremented? (not= old-database-is-auto-increment new-database-is-auto-increment)
new-db-partitioned? (not= new-db-partitioned old-db-partitioned)
new-db-required? (not= old-db-required new-db-required)
;; calculate combined updates
updates
(merge
(when new-db-type?
(log/infof "Database type of %s has changed from ''%s'' to ''%s''."
(common/field-metadata-name-for-logging table metabase-field)
old-database-type
new-database-type)
{:database_type new-database-type})
(when new-base-type?
(log/infof "Base type of %s has changed from ''%s'' to ''%s''. This field will be refingerprinted and analyzed."
(common/field-metadata-name-for-logging table metabase-field)
old-base-type
new-base-type)
{:base_type new-base-type
:effective_type new-base-type
:coercion_strategy nil
;; reset fingerprint version so this field will get re-fingerprinted and analyzed
:fingerprint_version 0
:fingerprint nil
;; semantic type needs to be set to nil so that the fingerprinter can re-infer it during analysis
:semantic_type nil})
(when new-semantic-type?
(log/infof "Semantic type of {0} has changed from ''%s'' to ''%s''."
(common/field-metadata-name-for-logging table metabase-field)
old-semantic-type
new-semantic-type)
{:semantic_type new-semantic-type})
(when new-comment?
(log/infof "Comment has been added for %s."
(common/field-metadata-name-for-logging table metabase-field))
{:description new-field-comment})
(when new-database-position?
(log/infof "Database position of %s has changed from ''%s'' to ''%s''."
(common/field-metadata-name-for-logging table metabase-field)
old-database-position
new-database-position)
{:database_position new-database-position})
(when (and (= (:field_order table) :database)
(not= old-position new-database-position))
(log/infof "Position of %s has changed from ''%s'' to ''%s''."
(common/field-metadata-name-for-logging table metabase-field)
old-position
new-database-position)
{:position new-database-position})
(when new-name?
(log/infof "Name of %s has changed from ''%s'' to ''%s''."
(common/field-metadata-name-for-logging table metabase-field)
old-database-name
new-database-name)
{:name new-database-name})
(when new-db-auto-incremented?
(log/infof "Database auto incremented of %s has changed from ''%s'' to ''%s''."
(common/field-metadata-name-for-logging table metabase-field)
old-database-is-auto-increment
new-database-is-auto-increment)
{:database_is_auto_increment new-database-is-auto-increment})
(when new-db-partitioned?
(log/infof "Database partitioned of %s has changed from ''%s'' to ''%s''."
(common/field-metadata-name-for-logging table metabase-field)
old-db-partitioned
new-db-partitioned)
{:database_partitioned new-db-partitioned})
(when new-db-required?
(log/infof "Database required of %s has changed from ''%s'' to ''%s''."
(common/field-metadata-name-for-logging table metabase-field)
old-db-required
new-db-required)
{:database_required new-db-required}))]
;; if any updates need to be done, do them and return 1 (because 1 Field was updated), otherwise return 0
(if (and (seq updates)
(pos? (t2/update! Field (u/the-id metabase-field) updates)))
1
0))) | |
(declare update-metadata!) | |
(mu/defn ^:private update-nested-fields-metadata! :- ms/IntGreaterThanOrEqualToZero
"Recursively call `update-metadata!` for all the nested Fields in a `metabase-field`."
[table :- i/TableInstance
field-metadata :- i/TableMetadataField
metabase-field :- common/TableMetadataFieldWithID]
(let [nested-fields-metadata (:nested-fields field-metadata)
metabase-nested-fields (:nested-fields metabase-field)]
(if (seq metabase-nested-fields)
(update-metadata! table (set nested-fields-metadata) (set metabase-nested-fields))
0))) | |
(mu/defn update-metadata! :- ms/IntGreaterThanOrEqualToZero
"Make sure things like PK status and base-type are in sync with what has come back from the DB. Recursively updates
nested Fields. Returns total number of Fields updated."
[table :- i/TableInstance
db-metadata :- [:set i/TableMetadataField]
our-metadata :- [:set common/TableMetadataFieldWithID]]
(sync-util/sum-for [metabase-field our-metadata]
;; only update metadata for 'existing' Fields that are present in our Metadata (i.e., present in the application
;; database) and that are still considered active (i.e., present in DB metadata)
(when-let [field-metadata (common/matching-field-metadata metabase-field db-metadata)]
(+ (update-field-metadata-if-needed! table field-metadata metabase-field)
(update-nested-fields-metadata! table field-metadata metabase-field))))) | |
Logic for updating FK properties of Fields from metadata fetched from a physical DB. | (ns metabase.sync.sync-metadata.fks (:require [metabase.models.field :refer [Field]] [metabase.models.table :as table :refer [Table]] [metabase.sync.fetch-metadata :as fetch-metadata] [metabase.sync.interface :as i] [metabase.sync.util :as sync-util] [metabase.util :as u] [metabase.util.log :as log] [metabase.util.malli :as mu] [toucan2.core :as t2])) |
Relevant objects for a foreign key relationship. | (def ^:private FKRelationshipObjects [:map [:source-field i/FieldInstance] [:dest-table i/TableInstance] [:dest-field i/FieldInstance]]) |
(mu/defn ^:private fetch-fk-relationship-objects :- [:maybe FKRelationshipObjects]
"Fetch the Metabase objects (Tables and Fields) that are relevant to a foreign key relationship described by FK."
[database :- i/DatabaseInstance
table :- i/TableInstance
fk :- i/FKMetadataEntry]
(when-let [source-field (t2/select-one Field
:table_id (u/the-id table)
:%lower.name (u/lower-case-en (:fk-column-name fk))
:fk_target_field_id nil
:active true
:visibility_type [:not= "retired"])]
(when-let [dest-table (t2/select-one Table
:db_id (u/the-id database)
:%lower.name (u/lower-case-en (-> fk :dest-table :name))
:%lower.schema (when-let [schema (-> fk :dest-table :schema)]
(u/lower-case-en schema))
:active true
:visibility_type nil)]
(when-let [dest-field (t2/select-one Field
:table_id (u/the-id dest-table)
:%lower.name (u/lower-case-en (:dest-column-name fk))
:active true
:visibility_type [:not= "retired"])]
{:source-field source-field
:dest-table dest-table
:dest-field dest-field})))) | |
(mu/defn ^:private mark-fk!
[database :- i/DatabaseInstance
table :- i/TableInstance
fk :- i/FKMetadataEntry]
(when-let [{:keys [source-field dest-table dest-field]} (fetch-fk-relationship-objects database table fk)]
(log/info (u/format-color 'cyan "Marking foreign key from %s %s -> %s %s"
(sync-util/name-for-logging table)
(sync-util/name-for-logging source-field)
(sync-util/name-for-logging dest-table)
(sync-util/name-for-logging dest-field)))
(t2/update! Field (u/the-id source-field)
{:semantic_type :type/FK
:fk_target_field_id (u/the-id dest-field)})
true)) | |
Sync the foreign keys for a specific | (mu/defn sync-fks-for-table!
([table :- i/TableInstance]
(sync-fks-for-table! (table/database table) table))
([database :- i/DatabaseInstance
table :- i/TableInstance]
(sync-util/with-error-handling (format "Error syncing FKs for %s" (sync-util/name-for-logging table))
(let [fks-to-update (fetch-metadata/fk-metadata database table)]
{:total-fks (count fks-to-update)
:updated-fks (sync-util/sum-numbers (fn [fk]
(if (mark-fk! database table fk)
1
0))
fks-to-update)})))) |
Sync the foreign keys in a | (mu/defn sync-fks!
[database :- i/DatabaseInstance]
(reduce (fn [update-info table]
(let [table-fk-info (sync-fks-for-table! database table)]
;; Mark the table as done with its initial sync once this step is done even if it failed, because only
;; sync-aborting errors should be surfaced to the UI (see
;; `:metabase.sync.util/exception-classes-not-to-retry`).
(sync-util/set-initial-table-sync-complete! table)
(if (instance? Exception table-fk-info)
(update update-info :total-failed inc)
(merge-with + update-info table-fk-info))))
{:total-fks 0
:updated-fks 0
:total-failed 0}
(sync-util/db->sync-tables database))) |
(ns metabase.sync.sync-metadata.indexes (:require [clojure.data :as data] [metabase.driver :as driver] [metabase.driver.util :as driver.u] [metabase.models.field :as field] [metabase.sync.fetch-metadata :as fetch-metadata] [metabase.sync.util :as sync-util] [metabase.util.log :as log] [toucan2.core :as t2])) | |
(def ^:private empty-stats
{:total-indexes 0
:added-indexes 0
:removed-indexes 0}) | |
(defn- indexes->field-ids
[table-id indexes]
(when (seq indexes)
(let [normal-indexes (->> indexes (filter #(= (:type %) :normal-column-index)) (map :value))
nested-indexes (->> indexes (filter #(= (:type %) :nested-column-index)) (map :value))
normal-indexes-field-ids (when (seq normal-indexes)
(t2/select-pks-vec :model/Field :name [:in normal-indexes] :table_id table-id))
nested-indexes-field-ids (remove nil? (map #(field/nested-field-names->field-id table-id %) nested-indexes))]
(set (filter some? (concat normal-indexes-field-ids nested-indexes-field-ids)))))) | |
Sync the indexes for | (defn maybe-sync-indexes-for-table!
[database table]
(if (driver/database-supports? (driver.u/database->driver database) :index-info database)
(sync-util/with-error-handling (format "Error syncing Indexes for %s" (sync-util/name-for-logging table))
(let [indexes (fetch-metadata/index-metadata database table)
indexed-field-ids (indexes->field-ids (:id table) indexes)
existing-indexed-field-ids (t2/select-pks-set :model/Field :table_id (:id table) :database_indexed true)
[removing adding] (data/diff existing-indexed-field-ids indexed-field-ids)]
(doseq [field-id removing]
(log/infof "Unmarking Field %d as indexed" field-id))
(doseq [field-id adding]
(log/infof "Marking Field %d as indexed" field-id))
(if (or (seq adding) (seq removing))
(do (t2/update! :model/Field {:table_id (:id table)}
{:database_indexed (if (seq indexed-field-ids)
[:case [:in :id indexed-field-ids] true :else false]
false)})
{:total-indexes (count indexed-field-ids)
:added-indexes (count adding)
:removed-indexes (count removing)})
empty-stats)))
empty-stats)) |
Sync the indexes for all tables in | (defn maybe-sync-indexes!
[database]
(if (driver/database-supports? (driver.u/database->driver database) :index-info database)
(apply merge-with + empty-stats
(map #(maybe-sync-indexes-for-table! database %) (sync-util/db->sync-tables database)))
empty-stats)) |
Logic for syncing the special Currently, this is only used by the Sample Database, but theoretically in the future we could add additional sample datasets and preconfigure them by populating this Table; or 3rd-party applications or users can add this table to their database for an enhanced Metabase experience out-of-the box. | (ns metabase.sync.sync-metadata.metabase-metadata (:require [clojure.string :as str] [metabase.driver :as driver] [metabase.driver.util :as driver.u] [metabase.models.database :refer [Database]] [metabase.models.field :refer [Field]] [metabase.models.table :refer [Table]] [metabase.sync.fetch-metadata :as fetch-metadata] [metabase.sync.interface :as i] [metabase.sync.util :as sync-util] [metabase.util :as u] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
(def ^:private KeypathComponents [:map [:table-name [:maybe ms/NonBlankString]] [:field-name [:maybe ms/NonBlankString]] [:k :keyword]]) | |
(mu/defn ^:private parse-keypath :- KeypathComponents
"Parse a `keypath` into components for easy use."
;; TODO: this does not support schemas in dbs :(
[keypath :- ms/NonBlankString]
;; keypath will have one of three formats:
;; property (for database-level properties)
;; table_name.property
;; table_name.field_name.property
(let [[first-part second-part third-part] (str/split keypath #"\.")]
{:table-name (when second-part first-part)
:field-name (when third-part second-part)
:k (keyword (or third-part second-part first-part))})) | |
(mu/defn ^:private set-property! :- :boolean
"Set a property for a Field or Table in `database`. Returns `true` if a property was successfully set."
[database :- i/DatabaseInstance
{:keys [table-name field-name k]} :- KeypathComponents
value]
(boolean
;; ignore legacy entries that try to set field_type since it's no longer part of Field
(when-not (= k :field_type)
;; fetch the corresponding Table, then set the Table or Field property
(if table-name
(when-let [table-id (t2/select-one-pk Table
;; TODO: this needs to support schemas
:db_id (u/the-id database)
:name table-name
:active true)]
(if field-name
(pos? (t2/update! Field {:name field-name, :table_id table-id} {k value}))
(pos? (t2/update! Table table-id {k value}))))
(pos? (t2/update! Database (u/the-id database) {k value})))))) | |
Databases may include a table named The table should have the following schema: column | type | example --------+---------+------------------------------------------------- keypath | varchar | "products.created_at.description" value | varchar | "The date the product was added to our catalog."
This functionality is currently only used by the Sample Database. In order to use this functionality, drivers must
implement optional fn | (mu/defn ^:private sync-metabase-metadata-table!
[driver
database :- i/DatabaseInstance
metabase-metadata-table :- i/DatabaseMetadataTable]
(doseq [{:keys [keypath value]} (driver/table-rows-seq driver database metabase-metadata-table)]
(sync-util/with-error-handling (format "Error handling metabase metadata entry: set %s -> %s" keypath value)
(or (set-property! database (parse-keypath keypath) value)
(log/error (u/format-color 'red "Error syncing _metabase_metadata: no matching keypath: %s" keypath)))))) |
Is this TABLE the special | (mu/defn is-metabase-metadata-table? [table :- i/DatabaseMetadataTable] (= "_metabase_metadata" (u/lower-case-en (:name table)))) |
Sync the | (mu/defn sync-metabase-metadata!
([database :- i/DatabaseInstance]
(sync-metabase-metadata! database (fetch-metadata/db-metadata database)))
([database :- i/DatabaseInstance db-metadata]
(sync-util/with-error-handling (format "Error syncing _metabase_metadata table for %s"
(sync-util/name-for-logging database))
(let [driver (driver.u/database->driver database)]
;; `sync-metabase-metadata-table!` relies on `driver/table-rows-seq` being defined
(when (get-method driver/table-rows-seq driver)
;; If there's more than one metabase metadata table (in different schemas) we'll sync each one in turn.
;; Hopefully this is never the case.
(doseq [table (:tables db-metadata)]
(when (is-metabase-metadata-table? table)
(sync-metabase-metadata-table! driver database table))))
{})))) |
(ns metabase.sync.sync-metadata.sync-table-privileges (:require [metabase.driver :as driver] [metabase.driver.util :as driver.u] [metabase.models.interface :as mi] [metabase.util.malli :as mu] [toucan2.core :as t2])) | |
(set! *warn-on-reflection* true) | |
Sync the This is a cache of the data returned from | (mu/defn sync-table-privileges!
[database :- (mi/InstanceOf :model/Database)]
(let [driver (driver.u/database->driver database)]
(when (and (not= :redshift driver)
;; redshift does support table-privileges, but we don't want to sync it now because table privileges are
;; meant to enhance action features, but redshift does not support actions for now, so we skip it here.
(driver/database-supports? driver :table-privileges database))
(let [rows (driver/current-user-table-privileges driver database)
schema+table->id (t2/select-fn->pk (fn [t] {:schema (:schema t), :table (:name t)}) :model/Table :db_id (:id database))
rows-with-table-id (keep (fn [row]
(when-let [table-id (get schema+table->id (select-keys row [:schema :table]))]
(-> row
(assoc :table_id table-id)
(dissoc :schema :table))))
rows)]
(t2/with-transaction [_conn]
(t2/delete! :model/TablePrivileges :table_id [:in {:select [:t.id]
:from [[:metabase_table :t]]
:where [:= :t.db_id (:id database)]}])
{:total-table-privileges (t2/insert! :model/TablePrivileges rows-with-table-id)}))))) |
(ns metabase.sync.sync-metadata.sync-timezone
(:require
[java-time.api :as t]
[metabase.driver :as driver]
[metabase.driver.util :as driver.u]
[metabase.lib.schema.expression.temporal
:as lib.schema.expression.temporal]
[metabase.sync.interface :as i]
[metabase.util.i18n :refer [trs]]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[toucan2.core :as t2])) | |
(set! *warn-on-reflection* true) | |
(defn- validate-zone-id [driver zone-id]
(when zone-id
(when-not (some (fn [klass]
(instance? klass zone-id))
[String java.time.ZoneId java.time.ZoneOffset])
(throw (ex-info (format (str "metabase.driver/db-default-timezone should return a String, java.time.ZoneId, or "
"java.time.ZoneOffset, but the %s implementation returned ^%s %s")
(pr-str driver)
(.getCanonicalName (class zone-id))
(pr-str zone-id))
{:driver driver, :zone-id zone-id})))
(when (string? zone-id)
(try
(t/zone-id zone-id)
(catch Throwable e
(throw (ex-info (trs "Invalid timezone {0}: {1}" (pr-str zone-id) (ex-message e))
{:zone-id zone-id}
e)))))
zone-id)) | |
(mu/defn sync-timezone! :- [:map [:timezone-id [:maybe ::lib.schema.expression.temporal/timezone-id]]]
"Query `database` for its current time to determine its timezone. The results of this function are used by the sync
process to update the timezone if it's different."
[database :- i/DatabaseInstance]
(let [driver (driver.u/database->driver database)
zone-id (driver/db-default-timezone driver database)]
(log/infof "%s database %s default timezone is %s" driver (pr-str (:id database)) (pr-str zone-id))
(validate-zone-id driver zone-id)
(let [zone-id (some-> zone-id str)
zone-id (if (= zone-id "Z") "UTC" zone-id)]
(when-not (= zone-id (:timezone database))
(t2/update! :model/Database (:id database) {:timezone zone-id}))
{:timezone-id zone-id}))) | |
Logic for updating Metabase Table models from metadata fetched from a physical DB. | (ns metabase.sync.sync-metadata.tables (:require [clojure.data :as data] [clojure.set :as set] [medley.core :as m] [metabase.lib.schema.common :as lib.schema.common] [metabase.models.database :refer [Database]] [metabase.models.humanization :as humanization] [metabase.models.interface :as mi] [metabase.models.permissions :as perms] [metabase.models.permissions-group :as perms-group] [metabase.models.table :refer [Table]] [metabase.sync.fetch-metadata :as fetch-metadata] [metabase.sync.interface :as i] [metabase.sync.sync-metadata.metabase-metadata :as metabase-metadata] [metabase.sync.util :as sync-util] [metabase.util :as u] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
------------------------------------------------ "Crufty" Tables ------------------------------------------------- | |
Crufty tables are ones we know are from frameworks like Rails or Django and thus automatically mark as | |
Regular expressions that match Tables that should automatically given the | (def ^:private crufty-table-patterns
#{;; Django
#"^auth_group$"
#"^auth_group_permissions$"
#"^auth_permission$"
#"^django_admin_log$"
#"^django_content_type$"
#"^django_migrations$"
#"^django_session$"
#"^django_site$"
#"^south_migrationhistory$"
#"^user_groups$"
#"^user_user_permissions$"
;; Drupal
#".*_cache$"
#".*_revision$"
#"^advagg_.*"
#"^apachesolr_.*"
#"^authmap$"
#"^autoload_registry.*"
#"^batch$"
#"^blocked_ips$"
#"^cache.*"
#"^captcha_.*"
#"^config$"
#"^field_revision_.*"
#"^flood$"
#"^node_revision.*"
#"^queue$"
#"^rate_bot_.*"
#"^registry.*"
#"^router.*"
#"^semaphore$"
#"^sequences$"
#"^sessions$"
#"^watchdog$"
;; Rails / Active Record
#"^schema_migrations$"
#"^ar_internal_metadata$"
;; PostGIS
#"^spatial_ref_sys$"
;; nginx
#"^nginx_access_log$"
;; Liquibase
#"^databasechangelog$"
#"^databasechangeloglock$"
;; Lobos
#"^lobos_migrations$"
;; MSSQL
#"^syncobj_0x.*"}) |
Should we give newly created TABLE a | (mu/defn ^:private is-crufty-table? [table :- i/DatabaseMetadataTable] (some #(re-find % (u/lower-case-en (:name table))) crufty-table-patterns)) |
---------------------------------------------------- Syncing ----------------------------------------------------- | |
If there is a version in the db-metadata update the DB to have that in the DB model | (mu/defn ^:private update-database-metadata!
[database :- i/DatabaseInstance
db-metadata :- i/DatabaseMetadata]
(log/infof "Found new version for DB: %s" (:version db-metadata))
(t2/update! Database (u/the-id database)
{:details
(assoc (:details database) :version (:version db-metadata))})) |
Create a single new table in the database, or mark it as active if it already exists. | (defn create-or-reactivate-table!
[database {schema :schema table-name :name :as table}]
(let [;; if this is a crufty table, mark initial sync as complete since we'll skip the subsequent sync steps
is-crufty? (is-crufty-table? table)
initial-sync-status (if is-crufty? "complete" "incomplete")
visibility-type (when is-crufty? :cruft)]
(if-let [existing-id (t2/select-one-pk Table
:db_id (u/the-id database)
:schema schema
:name table-name
:active false)]
;; if the table already exists but is marked *inactive*, mark it as *active*
(t2/update! Table existing-id
{:active true
:visibility_type visibility-type
:initial_sync_status initial-sync-status})
;; otherwise create a new Table
(first (t2/insert-returning-instances! Table
:db_id (u/the-id database)
:schema schema
:description (:description table)
:database_require_filter (:database_require_filter table)
:name table-name
:display_name (humanization/name->human-readable-name table-name)
:active true
:visibility_type visibility-type
:initial_sync_status initial-sync-status))))) |
TODO - should we make this logic case-insensitive like it is for fields? | |
Create | (mu/defn ^:private create-or-reactivate-tables!
[database :- i/DatabaseInstance
new-tables :- [:set i/DatabaseMetadataTable]]
(log/info "Found new tables:"
(for [table new-tables]
(sync-util/name-for-logging (mi/instance Table table))))
(doseq [table new-tables]
(create-or-reactivate-table! database table))) |
Mark any | (mu/defn ^:private retire-tables!
[database :- i/DatabaseInstance
old-tables :- [:set [:map
[:name ::lib.schema.common/non-blank-string]
[:schema [:maybe ::lib.schema.common/non-blank-string]]]]]
(log/info "Marking tables as inactive:"
(for [table old-tables]
(sync-util/name-for-logging (mi/instance Table table))))
(doseq [{schema :schema table-name :name :as _table} old-tables]
(t2/update! Table {:db_id (u/the-id database)
:schema schema
:name table-name
:active true}
{:active false}))) |
Update the table metadata if it has changed. | (mu/defn ^:private update-table-metadata-if-needed!
[table-metadata :- i/DatabaseMetadataTable
metabase-table :- (ms/InstanceOf :model/Table)]
(log/infof "Updating table metadata for %s" (sync-util/name-for-logging metabase-table))
(let [to-update-keys [:description :database_require_filter]
old-table (select-keys metabase-table to-update-keys)
new-table (select-keys (merge
(zipmap to-update-keys (repeat nil))
table-metadata)
to-update-keys)
[_ changes _] (data/diff old-table new-table)
changes (cond-> changes
;; we only update the description if the initial state is nil
;; because don't want to override the user edited description if it exists
(some? (:description old-table))
(dissoc changes :description))]
(doseq [[k v] changes]
(log/infof "%s of %s changed from %s to %s"
k
(sync-util/name-for-logging metabase-table)
(get metabase-table k)
v))
(when (seq changes)
(t2/update! :model/Table (:id metabase-table) changes)))) |
(mu/defn ^:private update-tables-metadata-if-needed!
[table-metadatas :- [:set i/DatabaseMetadataTable]
metabase-tables :- [:set (ms/InstanceOf :model/Table)]]
(let [name+schema->table-metadata (m/index-by (juxt :name :schema) table-metadatas)
name+schema->metabase-table (m/index-by (juxt :name :schema) metabase-tables)]
(doseq [name+schema (set/intersection (set (keys name+schema->table-metadata)) (set (keys name+schema->metabase-table)))]
(update-table-metadata-if-needed! (name+schema->table-metadata name+schema) (name+schema->metabase-table name+schema))))) | |
(mu/defn ^:private table-set :- [:set i/DatabaseMetadataTable]
"So there exist tables for the user and metabase metadata tables for internal usage by metabase.
Get set of user tables only, excluding metabase metadata tables."
[db-metadata :- i/DatabaseMetadata]
(into #{}
(remove metabase-metadata/is-metabase-metadata-table?)
(:tables db-metadata))) | |
(mu/defn ^:private db->our-metadata :- [:set i/DatabaseMetadataTable]
"Return information about what Tables we have for this DB in the Metabase application DB."
[database :- i/DatabaseInstance]
(set (t2/select [:model/Table :id :name :schema :description :database_require_filter]
:db_id (u/the-id database)
:active true))) | |
Sync the Tables recorded in the Metabase application database with the ones obtained by calling | (mu/defn sync-tables-and-database!
([database :- i/DatabaseInstance]
(sync-tables-and-database! database (fetch-metadata/db-metadata database)))
([database :- i/DatabaseInstance db-metadata]
;; determine what's changed between what info we have and what's in the DB
(let [db-tables (table-set db-metadata)
name+schema #(select-keys % [:name :schema])
name+schema->db-table (m/index-by name+schema db-tables)
our-metadata (db->our-metadata database)
keep-name+schema-set (fn [metadata]
(set (map name+schema metadata)))
[new-tables old-tables] (data/diff
(keep-name+schema-set (set (map name+schema db-tables)))
(keep-name+schema-set (set (map name+schema our-metadata))))]
;; update database metadata from database
(when (some? (:version db-metadata))
(sync-util/with-error-handling (format "Error creating/reactivating tables for %s"
(sync-util/name-for-logging database))
(update-database-metadata! database db-metadata)))
;; create new tables as needed or mark them as active again
(when (seq new-tables)
(let [new-tables-info (set (map #(get name+schema->db-table (name+schema %)) new-tables))]
(sync-util/with-error-handling (format "Error creating/reactivating tables for %s"
(sync-util/name-for-logging database))
(create-or-reactivate-tables! database new-tables-info))))
;; mark old tables as inactive
(when (seq old-tables)
(sync-util/with-error-handling (format "Error retiring tables for %s" (sync-util/name-for-logging database))
(retire-tables! database old-tables)))
(sync-util/with-error-handling (format "Error updating table metadata for %s" (sync-util/name-for-logging database))
;; we need to fetch the tables again because we might have retired tables in the previous steps
(update-tables-metadata-if-needed! db-tables (db->our-metadata database)))
;; update native download perms for all groups if any tables were added or removed
(when (or (seq new-tables) (seq old-tables))
(sync-util/with-error-handling (format "Error updating native download perms for %s" (sync-util/name-for-logging database))
(doseq [{id :id} (perms-group/non-admin-groups)]
(perms/update-native-download-permissions! id (u/the-id database)))))
{:updated-tables (+ (count new-tables) (count old-tables))
:total-tables (count our-metadata)}))) |
Utility functions and macros to abstract away some common patterns and operations across the sync processes, such as logging start/end messages. | (ns metabase.sync.util (:require [clojure.math.numeric-tower :as math] [clojure.string :as str] [java-time.api :as t] [medley.core :as m] [metabase.driver :as driver] [metabase.driver.util :as driver.u] [metabase.events :as events] [metabase.models.field :refer [Field]] [metabase.models.interface :as mi] [metabase.models.task-history :refer [TaskHistory]] [metabase.query-processor.interface :as qp.i] [metabase.sync.interface :as i] [metabase.util :as u] [metabase.util.date-2 :as u.date] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.registry :as mr] [metabase.util.malli.schema :as ms] [toucan2.core :as t2]) (:import (java.time.temporal Temporal))) |
(set! *warn-on-reflection* true) | |
(derive ::event :metabase/event) | |
(def ^:private sync-event-topics
#{:event/sync-begin
:event/sync-end
:event/analyze-begin
:event/analyze-end
:event/refingerprint-begin
:event/refingerprint-end
:event/cache-field-values-begin
:event/cache-field-values-end
:event/sync-metadata-begin
:event/sync-metadata-end}) | |
(doseq [topic sync-event-topics] (derive topic ::event)) | |
(def ^:private Topic
[:and
events/Topic
[:fn
{:error/message "Sync event deriving from :metabase.sync.util/event"}
#(isa? % ::event)]]) | |
+----------------------------------------------------------------------------------------------------------------+ | SYNC OPERATION "MIDDLEWARE" | +----------------------------------------------------------------------------------------------------------------+ | |
When using the These basically operate in a middleware pattern, where the various different steps take a function, and return a new function that will execute the original in whatever context or with whatever side effects appropriate for that step. | |
This looks something like {:sync #{1 2}, :cache #{2 3}} when populated.
Key is a type of sync operation, e.g. TODO - as @salsakran mentioned it would be nice to do this via the DB so we could better support multi-instance setups in the future | (defonce ^:private operation->db-ids (atom {})) |
Run ;; Only one | (defn with-duplicate-ops-prevented
[operation database-or-id f]
(fn []
(when-not (contains? (@operation->db-ids operation) (u/the-id database-or-id))
(try
;; mark this database as currently syncing so we can prevent duplicate sync attempts (#2337)
(swap! operation->db-ids update operation #(conj (or % #{}) (u/the-id database-or-id)))
(log/debug "Sync operations in flight:" (m/filter-vals seq @operation->db-ids))
;; do our work
(f)
;; always take the ID out of the set when we are through
(finally
(swap! operation->db-ids update operation #(disj % (u/the-id database-or-id)))))))) |
Publish events related to beginning and ending a sync-like process, e.g. | (mu/defn ^:private with-sync-events
{:style/indent [:form]}
;; we can do everyone a favor and infer the name of the individual begin and sync events
([event-name-prefix database-or-id f]
(letfn [(event-keyword [prefix suffix]
(keyword (or (namespace event-name-prefix) "event")
(str (name prefix) suffix)))]
(with-sync-events
(event-keyword event-name-prefix "-begin")
(event-keyword event-name-prefix "-end")
database-or-id
f)))
([begin-event-name :- Topic
end-event-name :- Topic
database-or-id
f]
(fn []
(let [start-time (System/nanoTime)
tracking-hash (str (random-uuid))]
(events/publish-event! begin-event-name {:database_id (u/the-id database-or-id), :custom_id tracking-hash})
(let [return (f)
total-time-ms (int (/ (- (System/nanoTime) start-time)
1000000.0))]
(events/publish-event! end-event-name {:database_id (u/the-id database-or-id)
:custom_id tracking-hash
:running_time total-time-ms})
return))))) |
Logs start/finish messages using | (defn- with-start-and-finish-logging*
{:style/indent [:form]}
[log-fn message f]
(let [start-time (System/nanoTime)
_ (log-fn (u/format-color 'magenta "STARTING: %s" message))
result (f)]
(log-fn (u/format-color 'magenta "FINISHED: %s (%s)"
message
(u/format-nanoseconds (- (System/nanoTime) start-time))))
result)) |
Log | (defn- with-start-and-finish-logging
{:style/indent [:form]}
[message f]
(fn []
(with-start-and-finish-logging* #(log/info %) message f))) |
Similar to | (defn with-start-and-finish-debug-logging
{:style/indent [:form]}
[message f]
(with-start-and-finish-logging* #(log/info %) message f)) |
Disable all QP and DB logging when running BODY. (This should be done for all sync-like processes to avoid cluttering the logs.) | (defn- with-db-logging-disabled
{:style/indent [:form]}
[f]
(fn []
(binding [qp.i/*disable-qp-logging* true]
(f)))) |
Pass the sync operation defined by | (defn- sync-in-context
[database f]
(fn []
(driver/sync-in-context (driver.u/database->driver database) database
f))) |
TODO: future, expand this to | (doseq [klass [java.net.ConnectException
java.net.NoRouteToHostException
java.net.UnknownHostException
com.mchange.v2.resourcepool.CannotAcquireResourceException
javax.net.ssl.SSLHandshakeException]]
(derive klass ::exception-class-not-to-retry)) |
Whether to log exceptions during a sync step and proceed with the rest of the sync process. This is the default behavior. You can disable this for debugging or test purposes. | (def ^:dynamic *log-exceptions-and-continue?* true) |
Internal implementation of [[with-error-handling]]; use that instead of calling this directly. | (defn do-with-error-handling
([f]
(do-with-error-handling "Error running sync step" f))
([message f]
(try
(f)
(catch Throwable e
(if *log-exceptions-and-continue?*
(do
(log/warn e message)
e)
(throw (ex-info (format "%s: %s" message (ex-message e)) {} e))))))) |
Execute The exception classes deriving from | (defmacro with-error-handling
{:style/indent 1}
[message & body]
`(do-with-error-handling ~message (fn [] ~@body))) |
Internal implementation of [[sync-operation]]; use that instead of calling this directly. | (mu/defn do-sync-operation
[operation :- :keyword ; something like `:sync-metadata` or `:refingerprint`
database :- (ms/InstanceOf :model/Database)
message :- ms/NonBlankString
f :- fn?]
((with-duplicate-ops-prevented operation database
(with-sync-events operation database
(with-start-and-finish-logging message
(with-db-logging-disabled
(sync-in-context database
(partial do-with-error-handling (format "Error in sync step %s" message) f)))))))) |
Perform the operations in | (defmacro sync-operation
{:style/indent 3}
[operation database message & body]
`(do-sync-operation ~operation ~database ~message (fn [] ~@body))) |
+----------------------------------------------------------------------------------------------------------------+ | EMOJI PROGRESS METER | +----------------------------------------------------------------------------------------------------------------+ | |
This is primarily provided because it makes sync more fun to look at. The functions below make it fairly simple to log a progress bar with a corresponding emoji when iterating over a sequence of objects during sync, e.g. syncing all the Tables in a given Database. | |
(def ^:private ^:const ^Integer emoji-meter-width 50) | |
(def ^:private progress-emoji ["😱" ; face screaming in fear "😢" ; crying face "😞" ; disappointed face "😒" ; unamused face "😕" ; confused face "😐" ; neutral face "😬" ; grimacing face "😌" ; relieved face "😏" ; smirking face "😋" ; face savouring delicious food "😊" ; smiling face with smiling eyes "😍" ; smiling face with heart shaped eyes "😎"]) ; smiling face with sunglasses | |
(defn- percent-done->emoji [percent-done] (progress-emoji (int (math/round (* percent-done (dec (count progress-emoji))))))) | |
Create a string that shows progress for something, e.g. a database sync process. (emoji-progress-bar 10 40) -> "[****······································] 😒 25% | (defn emoji-progress-bar
[completed total log-every-n]
(let [percent-done (float (/ completed total))
filleds (int (* percent-done emoji-meter-width))
blanks (- emoji-meter-width filleds)]
(when (or (zero? (mod completed log-every-n))
(= completed total))
(str "["
(str/join (repeat filleds "*"))
(str/join (repeat blanks "·"))
(format "] %s %3.0f%%" (u/emoji (percent-done->emoji percent-done)) (* percent-done 100.0)))))) |
Run BODY with access to a function that makes using our amazing emoji-progress-bar easy like Sunday morning. Calling the function will return the approprate string output for logging and automatically increment an internal counter as needed. (with-emoji-progress-bar [progress-bar 10] (dotimes [i 10] (println (progress-bar)))) | (defmacro with-emoji-progress-bar
{:style/indent 1}
[[emoji-progress-fn-binding total-count] & body]
`(let [finished-count# (atom 0)
total-count# ~total-count
log-every-n# (Math/ceil (/ total-count# 10))
~emoji-progress-fn-binding (fn [] (emoji-progress-bar (swap! finished-count# inc) total-count# log-every-n#))]
~@body)) |
+----------------------------------------------------------------------------------------------------------------+ | INITIAL SYNC STATUS | +----------------------------------------------------------------------------------------------------------------+ | |
If this is the first sync of a database, we need to update the | |
Marks initial sync as complete for this table so that it becomes usable in the UI, if not already set | (defn set-initial-table-sync-complete!
[table]
(when (not= (:initial_sync_status table) "complete")
(t2/update! :model/Table (u/the-id table) {:initial_sync_status "complete"}))) |
Marks initial sync as complete for this database so that this is reflected in the UI, if not already set | (defn set-initial-database-sync-complete!
[database]
(when (not= (:initial_sync_status database) "complete")
(t2/update! :model/Database (u/the-id database) {:initial_sync_status "complete"}))) |
Marks initial sync as aborted for this database so that an error can be displayed on the UI | (defn set-initial-database-sync-aborted!
[database]
(when (not= (:initial_sync_status database) "complete")
(t2/update! :model/Database (u/the-id database) {:initial_sync_status "aborted"}))) |
+----------------------------------------------------------------------------------------------------------------+ | OTHER SYNC UTILITY FUNCTIONS | +----------------------------------------------------------------------------------------------------------------+ | |
Return all the Tables that should go through the sync processes for | (defn db->sync-tables [database-or-id] (t2/select :model/Table, :db_id (u/the-id database-or-id), :active true, :visibility_type nil)) |
Return an appropriate string for logging an object in sync logging messages. Should be something like "postgres Database 'test-data'" This function is used all over the sync code to make sure we have easy access to consistently formatted descriptions of various objects. | (defmulti name-for-logging
{:arglists '([instance])}
mi/model) |
(defmethod name-for-logging :model/Database
[{database-name :name, id :id, engine :engine,}]
(format "%s Database %s ''%s''" (name engine) (str (or id "")) database-name)) | |
(defmethod name-for-logging :model/Table [{schema :schema, id :id, table-name :name}]
(format "Table %s ''%s''" (or (str id) "") (str (when (seq schema) (str schema ".")) table-name))) | |
(defmethod name-for-logging Field [{field-name :name, id :id}]
(format "Field %s ''%s''" (or (str id) "") field-name)) | |
this is used for result metadata stuff. | (defmethod name-for-logging :default [{field-name :name}]
(format "Field ''%s''" field-name)) |
(mu/defn calculate-duration-str :- :string "Given two datetimes, caculate the time between them, return the result as a string" [begin-time :- (ms/InstanceOfClass Temporal) end-time :- (ms/InstanceOfClass Temporal)] (u/format-nanoseconds (.toNanos (t/duration begin-time end-time)))) | |
Metadata common to both sync steps and an entire sync/analyze operation run | (def ^:private TimedSyncMetadata [:map [:start-time (ms/InstanceOfClass Temporal)] [:end-time (ms/InstanceOfClass Temporal)]]) |
(mr/def ::StepRunMetadata
[:merge
TimedSyncMetadata
[:map
[:log-summary-fn [:maybe [:=> [:cat :string] [:ref ::StepRunMetadata]]]]]]) | |
Map with metadata about the step. Contains both generic information like | (def ^:private StepRunMetadata [:ref ::StepRunMetadata]) |
(mr/def ::StepNameWithMetadata [:tuple ;; step name :string ;; step metadata StepRunMetadata]) | |
Pair with the step name and metadata about the completed step run | (def StepNameWithMetadata [:ref ::StepNameWithMetadata]) |
Timing and step information for the entire sync or analyze run | (def ^:private SyncOperationMetadata
[:merge
TimedSyncMetadata
[:map
[:steps [:maybe [:sequential StepNameWithMetadata]]]]]) |
A log summary function takes a | (def ^:private LogSummaryFunction [:=> [:cat :string] StepRunMetadata]) |
Defines a step. | (def ^:private StepDefinition [:map [:sync-fn [:=> [:cat StepRunMetadata] i/DatabaseInstance]] [:step-name :string] [:log-summary-fn [:maybe LogSummaryFunction]]]) |
Creates and returns a step suitable for | (defn create-sync-step
([step-name sync-fn]
(create-sync-step step-name sync-fn nil))
([step-name sync-fn log-summary-fn]
{:sync-fn sync-fn
:step-name step-name
:log-summary-fn (when log-summary-fn
(comp str log-summary-fn))})) |
(mu/defn run-step-with-metadata :- StepNameWithMetadata
"Runs `step` on `database` returning metadata from the run"
[database :- i/DatabaseInstance
{:keys [step-name sync-fn log-summary-fn] :as _step} :- StepDefinition]
(let [start-time (t/zoned-date-time)
results (with-start-and-finish-debug-logging (format "step ''%s'' for %s"
step-name
(name-for-logging database))
(fn [& args]
(try
(apply sync-fn database args)
(catch Throwable e
(if *log-exceptions-and-continue?*
(do
(log/warn e (format "Error running step ''%s'' for %s" step-name (name-for-logging database)))
{:throwable e})
(throw (ex-info (format "Error in sync step %s: %s" step-name (ex-message e)) {} e)))))))
end-time (t/zoned-date-time)]
[step-name (assoc results
:start-time start-time
:end-time end-time
:log-summary-fn log-summary-fn)])) | |
The logging logic from | (mu/defn ^:private make-log-sync-summary-str
[operation :- :string
database :- i/DatabaseInstance
{:keys [start-time end-time steps]} :- SyncOperationMetadata]
(str
(apply format
(str "\n#################################################################\n"
"# %s\n"
"# %s\n"
"# %s\n"
"# %s\n")
[(format "Completed %s on %s" operation (:name database))
(format "Start: %s" (u.date/format start-time))
(format "End: %s" (u.date/format end-time))
(format "Duration: %s" (calculate-duration-str start-time end-time))])
(apply str (for [[step-name {:keys [start-time end-time log-summary-fn] :as step-info}] steps]
(apply format (str "# ---------------------------------------------------------------\n"
"# %s\n"
"# %s\n"
"# %s\n"
"# %s\n"
(when log-summary-fn
(format "# %s\n" (log-summary-fn step-info))))
[(format "Completed step ''%s''" step-name)
(format "Start: %s" (u.date/format start-time))
(format "End: %s" (u.date/format end-time))
(format "Duration: %s" (calculate-duration-str start-time end-time))])))
"#################################################################\n")) |
Log a sync/analyze summary message with info from each step | (mu/defn ^:private log-sync-summary [operation :- :string database :- i/DatabaseInstance sync-metadata :- SyncOperationMetadata] ;; Note this needs to either stay nested in the `debug` macro call or be guarded by an log/enabled? ;; call. Constructing the log below requires some work, no need to incur that cost debug logging isn't enabled (log/debug (make-log-sync-summary-str operation database sync-metadata))) |
(def ^:private SyncOperationOrStepRunMetadata
[:multi
{:dispatch
#(contains? % :steps)}
[true SyncOperationMetadata]
[false StepRunMetadata]]) | |
(mu/defn ^:private create-task-history
[task-name :- ms/NonBlankString
database :- i/DatabaseInstance
{:keys [start-time end-time]} :- SyncOperationOrStepRunMetadata]
{:task task-name
:db_id (u/the-id database)
:started_at start-time
:ended_at end-time
:duration (.toMillis (t/duration start-time end-time))}) | |
(mu/defn ^:private store-sync-summary!
[operation :- :string
database :- i/DatabaseInstance
{:keys [steps] :as sync-md} :- SyncOperationMetadata]
(try
(->> (for [[step-name step-info] steps
:let [task-details (dissoc step-info :start-time :end-time :log-summary-fn)]]
(assoc (create-task-history step-name database step-info)
:task_details (when (seq task-details)
task-details)))
(cons (create-task-history operation database sync-md))
;; can't do `(t2/insert-returning-instances!)` with a seq because of this bug https://github.com/camsaul/toucan2/issues/130
(map #(t2/insert-returning-pks! TaskHistory %))
(map first)
doall)
(catch Throwable e
(log/warn e "Error saving task history")))) | |
(defn- do-not-retry-exception? [e]
(or (isa? (class e) ::exception-class-not-to-retry)
(some-> (ex-cause e) recur))) | |
Given the results of a sync step, returns truthy if a non-recoverable exception occurred | (defn abandon-sync?
[step-results]
(when-let [caught-exception (:throwable step-results)]
(do-not-retry-exception? caught-exception))) |
Run | (mu/defn run-sync-operation
[operation :- :string
database :- i/DatabaseInstance
sync-steps :- [:maybe [:sequential StepDefinition]]]
(let [start-time (t/zoned-date-time)
step-metadata (loop [[step-defn & rest-defns] sync-steps
result []]
(let [[step-name r] (run-step-with-metadata database step-defn)
new-result (conj result [step-name r])]
(cond (abandon-sync? r) new-result
(not (seq rest-defns)) new-result
:else (recur rest-defns new-result))))
end-time (t/zoned-date-time)
sync-metadata {:start-time start-time
:end-time end-time
:steps step-metadata}]
(store-sync-summary! operation database sync-metadata)
(log-sync-summary operation database sync-metadata)
sync-metadata)) |
Similar to a 2-arg call to | (defn sum-numbers
[f coll]
(reduce + (for [item coll
:let [result (f item)]
:when (number? result)]
result))) |
Impl for | (defn sum-for* [results] (reduce + (filter number? results))) |
Basically the same as As an added bonus, unlike normal | (defmacro sum-for
{:style/indent 1}
[[item-binding coll & more-for-bindings] & body]
`(sum-for* (for [~item-binding ~coll
~@more-for-bindings]
(do ~@body)))) |
Background task scheduling via Quartzite. Individual tasks are defined in Regarding Task Initialization:The most appropriate way to initialize tasks in any Quartz JavaDocFind the JavaDoc for Quartz here: http://www.quartz-scheduler.org/api/2.3.0/index.html | (ns metabase.task (:require [clojure.string :as str] [clojurewerkz.quartzite.scheduler :as qs] [environ.core :as env] [metabase.db :as mdb] [metabase.db.connection :as mdb.connection] [metabase.plugins.classloader :as classloader] [metabase.util :as u] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms]) (:import (org.quartz CronTrigger JobDetail JobKey Scheduler Trigger TriggerKey))) |
(set! *warn-on-reflection* true) | |
+----------------------------------------------------------------------------------------------------------------+ | SCHEDULER INSTANCE | +----------------------------------------------------------------------------------------------------------------+ | |
Override the global Quartz scheduler by binding this var. | (defonce ^:dynamic *quartz-scheduler* (atom nil)) |
Fetch the instance of our Quartz scheduler. | (defn- scheduler ^Scheduler [] @*quartz-scheduler*) |
+----------------------------------------------------------------------------------------------------------------+ | FINDING & LOADING TASKS | +----------------------------------------------------------------------------------------------------------------+ | |
Initialize (i.e., schedule) Job(s) with a given name. All implementations of this method are called once and only
once when the Quartz task scheduler is initialized. Task namespaces ( The dispatch value for this function can be any unique keyword, but by convention is a namespaced keyword version of the name of the Job being initialized; for sake of consistency with the Job name itself, the keyword should be left CamelCased. (defmethod task/init! ::SendPulses [_] (task/schedule-task! my-job my-trigger)) | (defmulti init!
{:arglists '([job-name-string])}
keyword) |
Search Classpath for namespaces that start with | (defn- find-and-load-task-namespaces!
[]
(doseq [ns-symb u/metabase-namespace-symbols
:when (.startsWith (name ns-symb) "metabase.task.")]
(try
(log/debug "Loading tasks namespace:" (u/format-color 'blue ns-symb))
(classloader/require ns-symb)
(catch Throwable e
(log/errorf e "Error loading tasks namespace %s" ns-symb))))) |
Call all implementations of | (defn- init-tasks!
[]
(doseq [[k f] (methods init!)]
(try
;; don't bother logging namespace for now, maybe in the future if there's tasks of the same name in multiple
;; namespaces we can log it
(log/infof "Initializing task %s" (u/format-color 'green (name k)) (u/emoji "📆"))
(f k)
(catch Throwable e
(log/error e "Error initializing task {0}" k))))) |
+----------------------------------------------------------------------------------------------------------------+ | Quartz Scheduler Connection Provider | +----------------------------------------------------------------------------------------------------------------+ | |
Custom | |
(defrecord ^:private ConnectionProvider []
org.quartz.utils.ConnectionProvider
(initialize [_])
(getConnection [_]
;; get a connection from our application DB connection pool. Quartz will close it (i.e., return it to the pool)
;; when it's done
;;
;; very important! Fetch a new connection from the connection pool rather than using currently bound Connection if
;; one already exists -- because Quartz will close this connection when done, we don't want to screw up the
;; calling block
;;
;; in a perfect world we could just check whether we're creating a new Connection or not, and if using an existing
;; Connection, wrap it in a delegating proxy wrapper that makes `.close()` a no-op but forwards all other methods.
;; Now that would be a useful macro!
(.getConnection mdb.connection/*application-db*))
(shutdown [_])) | |
(when-not *compile-files* (System/setProperty "org.quartz.dataSource.db.connectionProvider.class" (.getName ConnectionProvider))) | |
+----------------------------------------------------------------------------------------------------------------+ | Quartz Scheduler Class Load Helper | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- load-class ^Class [^String class-name] (Class/forName class-name true (classloader/the-classloader))) | |
(defrecord ^:private ClassLoadHelper []
org.quartz.spi.ClassLoadHelper
(initialize [_])
(getClassLoader [_]
(classloader/the-classloader))
(loadClass [_ class-name]
(load-class class-name))
(loadClass [_ class-name _]
(load-class class-name))) | |
(when-not *compile-files* (System/setProperty "org.quartz.scheduler.classLoadHelper.class" (.getName ClassLoadHelper))) | |
+----------------------------------------------------------------------------------------------------------------+ | STARTING/STOPPING SCHEDULER | +----------------------------------------------------------------------------------------------------------------+ | |
Set the appropriate system properties needed so Quartz can connect to the JDBC backend. (Since we don't know our DB
connection properties ahead of time, we'll need to set these at runtime rather than Setting them in the
| (defn- set-jdbc-backend-properties!
[]
(when (= (mdb/db-type) :postgres)
(System/setProperty "org.quartz.jobStore.driverDelegateClass" "org.quartz.impl.jdbcjobstore.PostgreSQLDelegate"))) |
Initialize our Quartzite scheduler which allows jobs to be submitted and triggers to scheduled. Puts scheduler in standby mode. Call [[start-scheduler!]] to begin running scheduled tasks. | (defn- init-scheduler!
[]
(classloader/the-classloader)
(when-not @*quartz-scheduler*
(set-jdbc-backend-properties!)
(let [new-scheduler (qs/initialize)]
(when (compare-and-set! *quartz-scheduler* nil new-scheduler)
(find-and-load-task-namespaces!)
(qs/standby new-scheduler)
(log/info "Task scheduler initialized into standby mode.")
(init-tasks!))))) |
this is a function mostly to facilitate testing. | (defn- disable-scheduler? [] (some-> (env/env :mb-disable-scheduler) Boolean/parseBoolean)) |
Start the task scheduler. Tasks do not run before calling this function. | (defn start-scheduler!
[]
(if (disable-scheduler?)
(log/warn "Metabase task scheduler disabled. Scheduled tasks will not be ran.")
(do (init-scheduler!)
(qs/start (scheduler))
(log/info "Task scheduler started")))) |
Stop our Quartzite scheduler and shutdown any running executions. | (defn stop-scheduler!
[]
(let [[old-scheduler] (reset-vals! *quartz-scheduler* nil)]
(when old-scheduler
(qs/shutdown old-scheduler)))) |
+----------------------------------------------------------------------------------------------------------------+ | SCHEDULING/DELETING TASKS | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn ^:private reschedule-task!
[job :- (ms/InstanceOfClass JobDetail) new-trigger :- (ms/InstanceOfClass Trigger)]
(try
(when-let [scheduler (scheduler)]
(when-let [[^Trigger old-trigger] (seq (qs/get-triggers-of-job scheduler (.getKey ^JobDetail job)))]
(log/debugf "Rescheduling job %s" (-> ^JobDetail job .getKey .getName))
(.rescheduleJob scheduler (.getKey old-trigger) new-trigger)))
(catch Throwable e
(log/error e "Error rescheduling job")))) | |
Add a given job and trigger to our scheduler. | (mu/defn schedule-task!
[job :- (ms/InstanceOfClass JobDetail) trigger :- (ms/InstanceOfClass Trigger)]
(when-let [scheduler (scheduler)]
(try
(qs/schedule scheduler job trigger)
(catch org.quartz.ObjectAlreadyExistsException _
(log/debug "Job already exists:" (-> ^JobDetail job .getKey .getName))
(reschedule-task! job trigger))))) |
delete a task from the scheduler | (mu/defn delete-task!
[job-key :- (ms/InstanceOfClass JobKey) trigger-key :- (ms/InstanceOfClass TriggerKey)]
(when-let [scheduler (scheduler)]
(qs/delete-trigger scheduler trigger-key)
(qs/delete-job scheduler job-key))) |
Add a job separately from a trigger, replace if the job is already there | (mu/defn add-job!
[job :- (ms/InstanceOfClass JobDetail)]
(when-let [scheduler (scheduler)]
(qs/add-job scheduler job true))) |
Add a trigger. Assumes the trigger is already associated to a job (i.e. | (mu/defn add-trigger!
[trigger :- (ms/InstanceOfClass Trigger)]
(when-let [scheduler (scheduler)]
(qs/add-trigger scheduler trigger))) |
Remove | (mu/defn delete-trigger!
[trigger-key :- (ms/InstanceOfClass TriggerKey)]
(when-let [scheduler (scheduler)]
(qs/delete-trigger scheduler trigger-key))) |
+----------------------------------------------------------------------------------------------------------------+ | Scheduler Info | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- job-detail->info [^JobDetail job-detail]
{:key (-> (.getKey job-detail) .getName)
:class (-> (.getJobClass job-detail) .getCanonicalName)
:description (.getDescription job-detail)
:concurrent-execution-disallowed? (.isConcurrentExectionDisallowed job-detail)
:durable? (.isDurable job-detail)
:requests-recovery? (.requestsRecovery job-detail)}) | |
(defmulti ^:private trigger->info
{:arglists '([trigger])}
class) | |
(defmethod trigger->info Trigger
[^Trigger trigger]
{:description (.getDescription trigger)
:end-time (.getEndTime trigger)
:final-fire-time (.getFinalFireTime trigger)
:key (-> (.getKey trigger) .getName)
:state (some->> (.getKey trigger) (.getTriggerState (scheduler)) str)
:next-fire-time (.getNextFireTime trigger)
:previous-fire-time (.getPreviousFireTime trigger)
:priority (.getPriority trigger)
:start-time (.getStartTime trigger)
:may-fire-again? (.mayFireAgain trigger)
:data (.getJobDataMap trigger)}) | |
(defmethod trigger->info CronTrigger
[^CronTrigger trigger]
(assoc
((get-method trigger->info Trigger) trigger)
:schedule
(.getCronExpression trigger)
:misfire-instruction
;; not 100% sure why `case` doesn't work here...
(condp = (.getMisfireInstruction trigger)
CronTrigger/MISFIRE_INSTRUCTION_IGNORE_MISFIRE_POLICY "IGNORE_MISFIRE_POLICY"
CronTrigger/MISFIRE_INSTRUCTION_SMART_POLICY "SMART_POLICY"
CronTrigger/MISFIRE_INSTRUCTION_FIRE_ONCE_NOW "FIRE_ONCE_NOW"
CronTrigger/MISFIRE_INSTRUCTION_DO_NOTHING "DO_NOTHING"
(format "UNKNOWN: %d" (.getMisfireInstruction trigger))))) | |
(defn- ->job-key ^JobKey [x]
(cond
(instance? JobKey x) x
(string? x) (JobKey. ^String x))) | |
Get info about a specific Job ( (task/job-info "metabase.task.sync-and-analyze.job") | (defn job-info
[job-key]
(when-let [scheduler (scheduler)]
(let [job-key (->job-key job-key)]
(try
(assoc (job-detail->info (qs/get-job scheduler job-key))
:triggers (for [trigger (sort-by #(-> ^Trigger % .getKey .getName)
(qs/get-triggers-of-job scheduler job-key))]
(trigger->info trigger)))
(catch ClassNotFoundException _
(log/infof "Class not found for Quartz Job %s. This probably means that this job was removed or renamed." (.getName job-key)))
(catch Throwable e
(log/warnf e "Error fetching details for Quartz Job: %s" (.getName job-key))))))) |
(defn- jobs-info []
(->> (some-> (scheduler) (.getJobKeys nil))
(sort-by #(.getName ^JobKey %))
(map job-info)
(filter some?))) | |
Return raw data about all the scheduler and scheduled tasks (i.e. Jobs and Triggers). Primarily for debugging purposes. | (defn scheduler-info
[]
{:scheduler (some-> (scheduler) .getMetaData .getSummary str/split-lines)
:jobs (jobs-info)}) |
(ns metabase.task.email-remove-legacy-pulse (:require [clojurewerkz.quartzite.jobs :as jobs] [clojurewerkz.quartzite.triggers :as triggers] [metabase.email :as email] [metabase.pulse] [metabase.task :as task] [metabase.util.log :as log] [metabase.util.urls :as urls] [stencil.core :as stencil] [toucan2.core :as t2])) | |
(set! *warn-on-reflection* true) | |
(defn- has-legacy-pulse? [] (pos? (t2/count :model/Pulse :dashboard_id nil :alert_condition nil :archived false))) | |
(def ^:private template-path (str "metabase/email/warn_deprecate_pulse.mustache")) | |
(defn- email-remove-legacy-pulse []
(when (and (email/email-configured?)
(has-legacy-pulse?))
(log/info "Sending email to admins about removal of legacy pulses")
(let [legacy-pulse (->> (t2/select :model/Pulse :dashboard_id nil :alert_condition nil :archived false)
(map #(assoc % :url (urls/legacy-pulse-url (:id %)))))]
(doseq [admin (t2/select :model/User :is_superuser true)]
(email/send-email-retrying!
{:recipients [(:email admin)]
:message-type :html
:subject "[Metabase] Removal of legacy pulses in upcoming Metabase release"
:message (stencil/render-file template-path {:userName (:common_name admin)
:pulses legacy-pulse
:instanceURL (urls/site-url)})}))))) | |
Send email to admins and warn about removal of Pulse in 49, This job will only run once. | (jobs/defjob EmailRemoveLegacyPulse [_ctx] (email-remove-legacy-pulse)) |
(defmethod task/init! ::SendWarnPulseRemovalEmail [_job-name]
(let [job (jobs/build
(jobs/of-type EmailRemoveLegacyPulse)
(jobs/with-identity (jobs/key "metabase.task.email-remove-legacy-pulse.job"))
(jobs/store-durably))
trigger (triggers/build
(triggers/with-identity (triggers/key "metabase.task.email-remove-legacy-pulse.trigger"))
(triggers/start-now))]
(task/schedule-task! job trigger))) | |
Tasks which follow up with Metabase users. | (ns metabase.task.follow-up-emails (:require [clojurewerkz.quartzite.jobs :as jobs] [clojurewerkz.quartzite.schedule.cron :as cron] [clojurewerkz.quartzite.triggers :as triggers] [java-time.api :as t] [metabase.email :as email] [metabase.email.messages :as messages] [metabase.models.setting :as setting] [metabase.models.user :as user :refer [User]] [metabase.public-settings :as public-settings] [metabase.task :as task] [metabase.util.date-2 :as u.date] [metabase.util.log :as log] [toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
+----------------------------------------------------------------------------------------------------------------+ | send follow-up emails | +----------------------------------------------------------------------------------------------------------------+ | |
Have we sent a follow up email to the instance admin? | (setting/defsetting ^:private follow-up-email-sent ;; No need to i18n this as it's not user facing :type :boolean :default false :visibility :internal :audit :never) |
Send an email to the instance admin following up on their experience with Metabase thus far. | (defn- send-follow-up-email!
[]
;; we need access to email AND the instance must be opted into anonymous tracking. Make sure email hasn't been sent yet
(when (and (email/email-configured?)
(public-settings/anon-tracking-enabled)
(not (follow-up-email-sent)))
;; grab the oldest admins email address (likely the user who created this MB instance), that's who we'll send to
;; TODO - Does it make to send to this user instead of `(public-settings/admin-email)`?
(when-let [admin (t2/select-one User :is_superuser true, :is_active true, {:order-by [:date_joined]})]
(try
(messages/send-follow-up-email! (:email admin))
(catch Throwable e
(log/error "Problem sending follow-up email:" e))
(finally
(follow-up-email-sent! true)))))) |
The date this Metabase instance was created. We use the | (defn- instance-creation-timestamp
^java.time.temporal.Temporal []
(t2/select-one-fn :date_joined User, {:order-by [[:date_joined :asc]]})) |
Sends out a general 2 week email follow up email | (jobs/defjob FollowUpEmail [_]
;; if we've already sent the follow-up email then we are done
(when-not (follow-up-email-sent)
;; figure out when we consider the instance created
(when-let [instance-created (instance-creation-timestamp)]
;; we need to be 2+ weeks from creation to send the follow up
(when (u.date/older-than? instance-created (t/weeks 2))
(send-follow-up-email!))))) |
(def ^:private follow-up-emails-job-key "metabase.task.follow-up-emails.job") (def ^:private follow-up-emails-trigger-key "metabase.task.follow-up-emails.trigger") | |
(defmethod task/init! ::SendFollowUpEmails [_]
(let [job (jobs/build
(jobs/of-type FollowUpEmail)
(jobs/with-identity (jobs/key follow-up-emails-job-key)))
trigger (triggers/build
(triggers/with-identity (triggers/key follow-up-emails-trigger-key))
(triggers/start-now)
(triggers/with-schedule
;; run once a day
(cron/cron-schedule "0 0 12 * * ? *")))]
(task/schedule-task! job trigger))) | |
(ns metabase.task.index-values (:require [clojurewerkz.quartzite.conversion :as qc] [clojurewerkz.quartzite.jobs :as jobs] [clojurewerkz.quartzite.schedule.cron :as cron] [clojurewerkz.quartzite.triggers :as triggers] [metabase.driver :as driver] [metabase.models.card :refer [Card]] [metabase.models.model-index :as model-index :refer [ModelIndex]] [metabase.query-processor.timezone :as qp.timezone] [metabase.task :as task] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [toucan2.core :as t2]) (:import (java.util TimeZone) (org.quartz ObjectAlreadyExistsException))) | |
(set! *warn-on-reflection* true) | |
States of a model index that are refreshable. | #_{:clj-kondo/ignore [:unused-private-var]}
(def ^:private refreshable-states
#{"indexed" "initial" "error" "overflow"}) |
Whether to unindex the the model indexing job. Will deindex if the model or model_index do not exist, if the model is no longer a model, or if archived. | (defn- should-deindex?
[model model-index]
(or (nil? model) (nil? model-index)
(not (:dataset model))
(:archived model))) |
(defn- model-index-trigger-key [model-index-id] (triggers/key (format "metabase.task.IndexValues.trigger.%d" model-index-id))) | |
Refresh the index on a model. Note, if the index should be removed (no longer a model, archived, etc, (see [[should-deindex?]])) will delete the indexing job. | (defn- refresh-index!
[model-index-id]
(let [model-index (t2/select-one ModelIndex :id model-index-id)
model (when model-index
(t2/select-one Card :id (:model_id model-index)))]
(if (should-deindex? model model-index)
(u/ignore-exceptions
(let [trigger-key (model-index-trigger-key model-index-id)]
(task/delete-trigger! trigger-key)
(t2/delete! ModelIndex model-index-id)))
(model-index/add-values! model-index)))) |
Refresh model indexed columns | (jobs/defjob ^{org.quartz.DisallowConcurrentExecution true
:doc }
ModelIndexRefresh [job-context]
(let [{:strs [model-index-id]} (qc/from-job-data job-context)]
(refresh-index! model-index-id))) |
Job key string for refresh job. Call | (def ^:private refresh-model-index-key "metabase.task.IndexValues.job") |
(def ^:private refresh-job (jobs/build (jobs/with-description "Indexed Value Refresh task") (jobs/of-type ModelIndexRefresh) (jobs/with-identity (jobs/key refresh-model-index-key)) (jobs/store-durably))) | |
(defn- refresh-trigger ^org.quartz.CronTrigger [model-index]
(triggers/build
(triggers/with-description (format "Refresh index on model %d" (:model_id model-index)))
(triggers/with-identity (model-index-trigger-key (:id model-index)))
(triggers/using-job-data {"model-index-id" (u/the-id model-index)})
(triggers/for-job (jobs/key refresh-model-index-key))
(triggers/start-now)
(triggers/with-schedule
(cron/schedule
(cron/cron-schedule (:schedule model-index))
(cron/in-time-zone (TimeZone/getTimeZone (or (driver/report-timezone)
(qp.timezone/system-timezone-id)
"UTC")))
(cron/with-misfire-handling-instruction-do-nothing))))) | |
Public API to start indexing a model. | (defn add-indexing-job
[model-index]
(let [trigger (refresh-trigger model-index)]
(log/info
(u/format-color :green (trs "Scheduling indexing for model: {0}" (:model_id model-index))))
(try (task/add-trigger! trigger)
(catch ObjectAlreadyExistsException _e
(log/info (u/format-color :red (trs "Index already present for model: {0}"
(:model_id model-index)))))
(catch Exception e
(log/warn (trs "Error scheduling indexing for model: {0}"
(:model_id model-index))
e))))) |
Public API to remove an indexing job on a model. | (defn remove-indexing-job
[model-index]
(let [trigger-key (model-index-trigger-key (:id model-index))]
(task/delete-trigger! trigger-key))) |
(defn- job-init! [] (task/add-job! refresh-job)) | |
(defmethod task/init! ::ModelIndexValues [_] (job-init!)) | |
(ns metabase.task.persist-refresh
(:require
[clojure.string :as str]
[clojurewerkz.quartzite.conversion :as qc]
[clojurewerkz.quartzite.jobs :as jobs]
[clojurewerkz.quartzite.schedule.cron :as cron]
[clojurewerkz.quartzite.triggers :as triggers]
[java-time.api :as t]
[medley.core :as m]
[metabase.db :as mdb]
[metabase.driver :as driver]
[metabase.driver.ddl.interface :as ddl.i]
[metabase.driver.sql.query-processor :as sql.qp]
[metabase.email.messages :as messages]
[metabase.models.card :refer [Card]]
[metabase.models.database :refer [Database]]
[metabase.models.persisted-info
:as persisted-info
:refer [PersistedInfo]]
[metabase.models.task-history :refer [TaskHistory]]
[metabase.public-settings :as public-settings]
[metabase.query-processor.middleware.limit :as limit]
[metabase.query-processor.timezone :as qp.timezone]
[metabase.task :as task]
[metabase.util :as u]
[metabase.util.i18n :refer [trs]]
[metabase.util.log :as log]
[potemkin.types :as p]
[toucan2.core :as t2])
(:import
(java.util TimeZone)
(org.quartz ObjectAlreadyExistsException Trigger))) | |
(set! *warn-on-reflection* true) | |
(defn- job-context->job-type [job-context] (select-keys (qc/from-job-data job-context) ["db-id" "persisted-id" "type"])) | |
This protocol is just a wrapper of the ddl.interface multimethods to ease for testing. Rather than defing some multimethods on fake engine types, just work against this, and it will dispatch to the ddl.interface normally, or allow for easy to control custom behavior in tests. | (p/defprotocol+ Refresher
(refresh! [this database definition dataset-query]
"Refresh a persisted model. Returns a map with :state that is :success or :error. If :state is :error, includes a
key :error with a string message. See [[metabase.driver.ddl.interface/refresh!]] for more information.")
(unpersist! [this database persisted-info])) |
Refresher implementation that dispatches to the multimethods in [[metabase.driver.ddl.interface]]. | (def ^:private dispatching-refresher
(reify Refresher
(refresh! [_ database definition card]
(binding [persisted-info/*allow-persisted-substitution* false]
(let [query (limit/disable-max-results (:dataset_query card))]
(ddl.i/refresh! (:engine database) database definition query))))
(unpersist! [_ database persisted-info]
(ddl.i/unpersist! (:engine database) database persisted-info)))) |
(defn- refresh-with-stats! [refresher database stats persisted-info]
;; Since this could be long running, double check state just before refreshing
(when (contains? (persisted-info/refreshable-states) (t2/select-one-fn :state PersistedInfo :id (:id persisted-info)))
(log/info (trs "Attempting to refresh persisted model {0}." (:card_id persisted-info)))
(let [card (t2/select-one Card :id (:card_id persisted-info))
definition (persisted-info/metadata->definition (:result_metadata card)
(:table_name persisted-info))
_ (t2/update! PersistedInfo (u/the-id persisted-info)
{:definition definition,
:query_hash (persisted-info/query-hash (:dataset_query card))
:active false,
:refresh_begin :%now,
:refresh_end nil,
:state "refreshing"
:state_change_at :%now})
{:keys [state error]} (try
(refresh! refresher database definition card)
(catch Exception e
(log/info e (trs "Error refreshing persisting model with card-id {0}"
(:card_id persisted-info)))
{:state :error :error (ex-message e)}))]
(t2/update! PersistedInfo (u/the-id persisted-info)
{:active (= state :success),
:refresh_end :%now,
:state (if (= state :success) "persisted" "error")
:state_change_at :%now
:error (when (= state :error) error)})
(if (= :success state)
(update stats :success inc)
(-> stats
(update :error-details conj {:persisted-info-id (:id persisted-info)
:error error})
(update :error inc)))))) | |
Create a task history entry with start, end, and duration. :task will be | (defn- save-task-history!
[task-type db-id f]
(let [start-time (t/zoned-date-time)
task-details (f)
end-time (t/zoned-date-time)]
(when (= task-type "persist-refresh")
(when-let [error-details (seq (:error-details task-details))]
(let [error-details-by-id (m/index-by :persisted-info-id error-details)
persisted-infos (->> (t2/hydrate (t2/select PersistedInfo :id [:in (keys error-details-by-id)])
[:card :collection] :database)
(map #(assoc % :error (get-in error-details-by-id [(:id %) :error]))))]
(messages/send-persistent-model-error-email!
db-id
persisted-infos
(:trigger task-details)))))
(t2/insert! TaskHistory {:task task-type
:db_id db-id
:started_at start-time
:ended_at end-time
:duration (.toMillis (t/duration start-time end-time))
:task_details task-details})
task-details)) |
Seam for tests to pass in specific deletables to drop. | (defn- prune-deletables!
[refresher deletables]
(when (seq deletables)
(let [db-id->db (m/index-by :id (t2/select Database :id [:in (map :database_id deletables)]))
unpersist-fn (fn []
(reduce (fn [stats persisted-info]
;; Since this could be long running, double check state just before deleting
(let [current-state (t2/select-one-fn :state PersistedInfo :id (:id persisted-info))
card-info (t2/select-one [Card :archived :dataset]
:id (:card_id persisted-info))]
(if (or (contains? (persisted-info/prunable-states) current-state)
(:archived card-info)
(not (:dataset card-info)))
(let [database (-> persisted-info :database_id db-id->db)]
(log/info (trs "Unpersisting model with card-id {0}" (:card_id persisted-info)))
(try
(unpersist! refresher database persisted-info)
(when (= "deletable" current-state)
(t2/delete! PersistedInfo :id (:id persisted-info)))
(update stats :success inc)
(catch Exception e
(log/info e (trs "Error unpersisting model with card-id {0}" (:card_id persisted-info)))
(update stats :error inc))))
(update stats :skipped inc))))
{:success 0, :error 0, :skipped 0}
deletables))]
(save-task-history! "unpersist-tables" nil unpersist-fn)))) |
Returns persisted info records that can be unpersisted. Will select records that have moved into a deletable state after a sufficient delay to ensure no queries are running against them and to allow changing mind. Also selects persisted info records pointing to cards that are no longer models and archived cards/models. | (defn- deletable-models
[]
(t2/select PersistedInfo
{:select [:p.*]
:from [[:persisted_info :p]]
:left-join [[:report_card :c] [:= :c.id :p.card_id]]
:where [:or
[:and
[:in :state (persisted-info/prunable-states)]
;; Buffer deletions for an hour if the
;; prune job happens soon after setting state.
;; 1. so that people have a chance to change their mind.
;; 2. if a query is running against the cache, it doesn't get ripped out.
[:< :state_change_at
(sql.qp/add-interval-honeysql-form (mdb/db-type) :%now -1 :hour)]]
[:= :c.dataset false]
[:= :c.archived true]]})) |
Returns refreshable models for a database id. Must still be models and not archived. | (defn- refreshable-models
[database-id]
(t2/select PersistedInfo
{:select [:p.* :c.dataset :c.archived :c.name]
:from [[:persisted_info :p]]
:left-join [[:report_card :c] [:= :c.id :p.card_id]]
:where [:and
[:= :p.database_id database-id]
[:in :p.state (persisted-info/refreshable-states)]
[:= :c.archived false]
[:= :c.dataset true]]})) |
Prunes all deletable PersistInfos, should not be called from tests as it will orphan cache tables if refresher is replaced. | (defn- prune-all-deletable!
[refresher]
(let [deletables (deletable-models)]
(prune-deletables! refresher deletables))) |
Refresh tables backing the persisted models. Updates all persisted tables with that database id which are in a state of "persisted". | (defn- refresh-tables!
[database-id refresher]
(log/info (trs "Starting persisted model refresh task for Database {0}." database-id))
(persisted-info/ready-unpersisted-models! database-id)
(let [database (t2/select-one Database :id database-id)
persisted (refreshable-models database-id)
thunk (fn []
(reduce (partial refresh-with-stats! refresher database)
{:success 0, :error 0, :trigger "Scheduled"}
persisted))
{:keys [error success]} (save-task-history! "persist-refresh" database-id thunk)]
(log/info
(trs "Finished persisted model refresh task for Database {0} with {1} successes and {2} errors." database-id success error)))) |
Refresh an individual model based on [[PersistedInfo]]. | (defn- refresh-individual!
[persisted-info-id refresher]
(let [persisted-info (t2/select-one PersistedInfo :id persisted-info-id)
database (when persisted-info
(t2/select-one Database :id (:database_id persisted-info)))]
(if (and persisted-info database)
(do
(save-task-history! "persist-refresh" (u/the-id database)
(partial refresh-with-stats!
refresher
database
{:success 0 :error 0, :trigger "Manual"}
persisted-info))
(log/info (trs "Finished updated model-id {0} from persisted-info {1}."
(:card_id persisted-info)
(u/the-id persisted-info))))
(log/info (trs "Unable to refresh model with card-id {0}" (:card_id persisted-info)))))) |
Refresh tables. Gets the database id from the job context and calls | (defn- refresh-job-fn!
[job-context]
(let [{:strs [type db-id persisted-id] :as _payload} (job-context->job-type job-context)]
(case type
"database" (refresh-tables! db-id dispatching-refresher)
"individual" (refresh-individual! persisted-id dispatching-refresher)
(log/info (trs "Unknown payload type {0}" type))))) |
(defn- prune-job-fn! [_job-context] (prune-all-deletable! dispatching-refresher)) | |
Refresh persisted tables job | (jobs/defjob ^{org.quartz.DisallowConcurrentExecution true
:doc }
PersistenceRefresh [job-context]
(refresh-job-fn! job-context)) |
Remove deletable persisted tables | (jobs/defjob ^{org.quartz.DisallowConcurrentExecution true
:doc }
PersistencePrune [job-context]
(prune-job-fn! job-context)) |
Job key string for refresh job. Call | (def ^:private refresh-job-key "metabase.task.PersistenceRefresh.job") |
Job key string for prune job. Call | (def ^:private prune-job-key "metabase.task.PersistencePrune.job") |
(def ^:private refresh-job (jobs/build (jobs/with-description "Persisted Model refresh task") (jobs/of-type PersistenceRefresh) (jobs/with-identity (jobs/key refresh-job-key)) (jobs/store-durably))) | |
(def ^:private prune-job (jobs/build (jobs/with-description "Persisted Model prune task") (jobs/of-type PersistencePrune) (jobs/with-identity (jobs/key prune-job-key)) (jobs/store-durably))) | |
(def ^:private prune-scheduled-trigger-key (triggers/key "metabase.task.PersistencePrune.scheduled.trigger")) | |
(def ^:private prune-once-trigger-key (triggers/key "metabase.task.PersistencePrune.once.trigger")) | |
(defn- database-trigger-key [database] (triggers/key (format "metabase.task.PersistenceRefresh.database.trigger.%d" (u/the-id database)))) | |
(defn- individual-trigger-key [persisted-info]
(triggers/key (format "metabase.task.PersistenceRefresh.individual.trigger.%d"
(u/the-id persisted-info)))) | |
Return a cron schedule that fires every | (defn- cron-schedule
[cron-spec]
(cron/schedule
(cron/cron-schedule cron-spec)
(cron/in-time-zone (TimeZone/getTimeZone (or (driver/report-timezone)
(qp.timezone/system-timezone-id)
"UTC")))
(cron/with-misfire-handling-instruction-do-nothing))) |
(comment
(let [[start-hour start-minute] (map parse-long (str/split "00:00" #":"))
hours 1]
(if (= 24 hours)
(format "0 %d %d * * ? *" start-minute start-hour)
(format "0 %d %d/%d * * ? *" start-minute start-hour hours)))) | |
(def ^:private prune-scheduled-trigger
(triggers/build
(triggers/with-description "Prune deletable PersistInfo once per hour")
(triggers/with-identity prune-scheduled-trigger-key)
(triggers/for-job (jobs/key prune-job-key))
(triggers/start-now)
(triggers/with-schedule
(cron-schedule "0 0 0/1 * * ? *")))) | |
(def ^:private prune-once-trigger
(triggers/build
(triggers/with-description "Prune deletable PersistInfo now")
(triggers/with-identity prune-once-trigger-key)
(triggers/for-job (jobs/key prune-job-key))
(triggers/start-now))) | |
(defn- database-trigger ^org.quartz.CronTrigger [database cron-spec]
(triggers/build
(triggers/with-description (format "Refresh models for database %d" (u/the-id database)))
(triggers/with-identity (database-trigger-key database))
(triggers/using-job-data {"db-id" (u/the-id database)
"type" "database"})
(triggers/for-job (jobs/key refresh-job-key))
(triggers/start-now)
(triggers/with-schedule
(cron-schedule cron-spec)))) | |
(defn- individual-trigger [persisted-info]
(triggers/build
(triggers/with-description (format "Refresh model %d: persisted-info %d"
(:card_id persisted-info)
(u/the-id persisted-info)))
(triggers/with-identity (individual-trigger-key persisted-info))
(triggers/using-job-data {"persisted-id" (u/the-id persisted-info)
"type" "individual"})
(triggers/for-job (jobs/key refresh-job-key))
(triggers/start-now))) | |
Schedule a database for persistence refreshing. | (defn schedule-persistence-for-database!
[database cron-spec]
(let [tggr (database-trigger database cron-spec)]
(log/info
(u/format-color 'green
"Scheduling persistence refreshes for database %d: trigger: %s"
(u/the-id database) (.. ^Trigger tggr getKey getName)))
(persisted-info/ready-database! (u/the-id database))
(try (task/add-trigger! tggr)
(catch ObjectAlreadyExistsException _e
(log/info
(u/format-color 'green "Persistence already present for database %d: trigger: %s"
(u/the-id database)
(.. ^Trigger tggr getKey getName))))))) |
Schedule a refresh of an individual [[PersistedInfo record]]. Done through quartz for locking purposes. | (defn schedule-refresh-for-individual!
[persisted-info]
(let [tggr (individual-trigger persisted-info)]
(log/info
(u/format-color 'green
"Scheduling refresh for model: %d"
(:card_id persisted-info)))
(try (task/add-trigger! tggr)
(catch ObjectAlreadyExistsException _e
(log/info
(u/format-color 'green "Persistence already present for model %d"
(:card_id persisted-info)
(.. ^Trigger tggr getKey getName))))))) |
other errors? | |
Fetch all database-ids that have a refresh job scheduled. | (defn job-info-by-db-id
[]
(some->> refresh-job-key
task/job-info
:triggers
(m/index-by (comp #(get % "db-id") qc/from-job-data :data)))) |
Return a set of PersistedInfo ids of all jobs scheduled for individual refreshes. TODO -- this is only used in [[metabase.api.card-test]] now | (defn job-info-for-individual-refresh
[]
(some->> refresh-job-key
task/job-info
:triggers
(map (comp qc/from-job-data :data))
(filter (comp #{"individual"} #(get % "type")))
(map #(get % "persisted-id"))
set)) |
Stop refreshing tables for a given database. Should only be called when marking the database as not persisting. Tables will be left over and up to the caller to clean up. | (defn unschedule-persistence-for-database! [database] (task/delete-trigger! (database-trigger-key database))) |
Unschedule all job triggers. | (defn- unschedule-all-refresh-triggers!
[job-key]
(let [trigger-keys (->> (task/job-info job-key)
:triggers
(map :key))]
(doseq [tk trigger-keys]
(task/delete-trigger! (triggers/key tk))))) |
Reschedule refresh for all enabled databases. Removes all existing triggers, and schedules refresh for databases with
| (defn reschedule-refresh!
[]
(let [dbs-with-persistence (filter (comp :persist-models-enabled :settings) (t2/select Database))
cron-schedule (public-settings/persisted-model-refresh-cron-schedule)]
(unschedule-all-refresh-triggers! refresh-job-key)
(doseq [db dbs-with-persistence]
(schedule-persistence-for-database! db cron-schedule)))) |
Enable persisting - The prune job is scheduled anew. - Refresh jobs are added when persist is enabled on a db. | (defn enable-persisting! [] (unschedule-all-refresh-triggers! prune-job-key) (task/add-trigger! prune-scheduled-trigger)) |
Disable persisting - All PersistedInfo are marked for deletion. - Refresh job triggers are removed. - Prune scheduled job trigger is removed. - The prune job is triggered to run immediately. | (defn disable-persisting!
[]
(persisted-info/mark-for-pruning! {})
(unschedule-all-refresh-triggers! refresh-job-key)
(task/delete-trigger! prune-scheduled-trigger-key)
;; ensure we clean up marked for deletion
(task/add-trigger! prune-once-trigger)) |
(defn- job-init! [] (task/add-job! refresh-job)) | |
(defmethod task/init! ::PersistRefresh [_] (job-init!) (reschedule-refresh!)) | |
(defmethod task/init! ::PersistPrune
[_]
(task/add-job! prune-job)
(when (public-settings/persisted-models-enabled)
(enable-persisting!))) | |
(ns metabase.task.refresh-slack-channel-user-cache (:require [clojurewerkz.quartzite.jobs :as jobs] [clojurewerkz.quartzite.schedule.cron :as cron] [clojurewerkz.quartzite.schedule.simple :as simple] [clojurewerkz.quartzite.triggers :as triggers] [metabase.integrations.slack :as slack] [metabase.task :as task] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log])) | |
(set! *warn-on-reflection* true) | |
(defn ^:private job []
(if (slack/slack-configured?)
(let [_ (log/info "Starting Slack user/channel startup cache refresh...")
start-ms (System/currentTimeMillis)
_ (slack/refresh-channels-and-usernames!)]
(log/info (trs "Slack user/channel startup cache refreshed with {0} entries, took {1}ms."
(count (:channels (slack/slack-cached-channels-and-usernames)))
(- (System/currentTimeMillis) start-ms))))
(log/info (trs "Slack is not configured, not refreshing slack user/channel cache.")))) | |
(def ^:private job-key "metabase.task.refresh-channel-cache.job") (def ^:private trigger-key "metabase.task.refresh-channel-cache.trigger") (def ^:private startup-job-key "metabase.task.on-startup-refresh-channel-cache.job") (def ^:private startup-trigger-key "metabase.task.on-startup-refresh-channel-cache.trigger") | |
General slack cache refresh job | (jobs/defjob RefreshCache [_] (job)) |
Startup cache refresh, with cleanup on failure. | (jobs/defjob RefreshCacheOnStartup [_]
(try (job)
(finally
(task/delete-task! (jobs/key startup-job-key)
(triggers/key startup-trigger-key))))) |
(defmethod task/init! ::RefreshSlackChannelsAndUsers
[_]
(let [job (jobs/build
(jobs/of-type RefreshCache)
(jobs/with-identity (jobs/key job-key)))
trigger (triggers/build
(triggers/with-identity (triggers/key trigger-key))
(triggers/with-schedule
(cron/schedule
(cron/cron-schedule
;; run every 4 hours at a random minute:
(format "0 %d 0/4 1/1 * ? *" (rand-int 60)))
(cron/with-misfire-handling-instruction-do-nothing)))
(triggers/start-now))
startup-job (jobs/build
(jobs/of-type RefreshCacheOnStartup)
(jobs/with-identity (jobs/key startup-job-key)))
startup-trigger (triggers/build
(triggers/with-identity (triggers/key startup-trigger-key))
(triggers/with-schedule
(simple/schedule (simple/with-interval-in-seconds 60)))
(triggers/start-now))]
(task/schedule-task! job trigger)
(task/schedule-task! startup-job startup-trigger))) | |
Contains a Metabase task which periodically sends anonymous usage information to the Metabase team. | (ns metabase.task.send-anonymous-stats (:require [clojurewerkz.quartzite.jobs :as jobs] [clojurewerkz.quartzite.schedule.cron :as cron] [clojurewerkz.quartzite.triggers :as triggers] [metabase.analytics.stats :as stats] [metabase.public-settings :as public-settings] [metabase.task :as task] [metabase.util.log :as log])) |
(set! *warn-on-reflection* true) | |
If we can collect usage data, do so and send it home | (jobs/defjob SendAnonymousUsageStats [_]
(when (public-settings/anon-tracking-enabled)
(log/debug "Sending anonymous usage stats.")
(try
;; TODO: add in additional request params if anonymous tracking is enabled
(stats/phone-home-stats!)
(catch Throwable e
(log/error e "Error sending anonymous usage stats"))))) |
(def ^:private job-key "metabase.task.anonymous-stats.job") (def ^:private trigger-key "metabase.task.anonymous-stats.trigger") | |
(defmethod task/init! ::SendAnonymousUsageStats
[_]
(let [job (jobs/build
(jobs/of-type SendAnonymousUsageStats)
(jobs/with-identity (jobs/key job-key)))
;; run at a random hour/minute
schedule (cron/cron-schedule
(format "0 %d %d * * ? *"
(rand-int 60)
(rand-int 24)))
trigger (triggers/build
(triggers/with-identity (triggers/key trigger-key))
(triggers/start-now)
(triggers/with-schedule schedule))]
(task/schedule-task! job trigger))) | |
Tasks related to running | (ns metabase.task.send-pulses (:require [clj-time.core :as time] [clj-time.predicates :as timepr] [clojurewerkz.quartzite.jobs :as jobs] [clojurewerkz.quartzite.schedule.cron :as cron] [clojurewerkz.quartzite.triggers :as triggers] [metabase.driver :as driver] [metabase.models :refer [PulseChannel]] [metabase.models.pulse :as pulse] [metabase.models.pulse-channel :as pulse-channel] [metabase.models.task-history :as task-history] [metabase.pulse] [metabase.task :as task] [metabase.util.log :as log] [metabase.util.malli :as mu] [toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
------------------------------------------------- PULSE SENDING -------------------------------------------------- | |
(defn- log-pulse-exception [pulse-id exception] (log/errorf exception "Error sending Pulse %d" pulse-id)) | |
(def ^:private Hour
[:int {:min 0 :max 23}]) | |
(def ^:private Weekday [:fn pulse-channel/day-of-week?]) | |
(def ^:private MonthDay [:enum :first :last :mid :other]) | |
(def ^:private MonthWeek [:enum :first :last :other]) | |
Send any | (mu/defn ^:private send-pulses!
([hour weekday monthday monthweek]
(send-pulses! hour weekday monthday monthweek log-pulse-exception))
([hour :- Hour, weekday :- Weekday, monthday :- MonthDay, monthweek :- MonthWeek, on-error]
(log/info "Sending scheduled pulses...")
(let [pulse-id->channels (group-by :pulse_id (pulse-channel/retrieve-scheduled-channels hour weekday monthday monthweek))]
(doseq [[pulse-id channels] pulse-id->channels]
(try
(task-history/with-task-history {:task "send-pulse"
:task_details {:pulse-id pulse-id}}
(log/debugf "Starting Pulse Execution: %d" pulse-id)
(when-let [pulse (pulse/retrieve-notification pulse-id :archived false)]
(metabase.pulse/send-pulse! pulse :channel-ids (map :id channels)))
(log/debugf "Finished Pulse Execution: %d" pulse-id))
(catch Throwable e
(on-error pulse-id e))))))) |
(defn- clear-pulse-channels!
[]
(when-let [ids-to-delete (seq
(for [channel (t2/select [PulseChannel :id :details]
:id [:not-in {:select [[:pulse_channel_id :id]]
:from :pulse_channel_recipient
:group-by [:pulse_channel_id]
:having [:>= :%count.* [:raw 1]]}])]
(when (and (empty? (get-in channel [:details :emails]))
(not (get-in channel [:details :channel])))
(:id channel))))]
(t2/delete! PulseChannel :id [:in ids-to-delete]))) | |
------------------------------------------------------ Task ------------------------------------------------------ | |
(defn- monthday [dt]
(cond
(timepr/first-day-of-month? dt) :first
(timepr/last-day-of-month? dt) :last
(= 15 (time/day dt)) :mid
:else :other)) | |
(defn- monthweek [dt]
(let [curr-day-of-month (time/day dt)
last-of-month (time/day (time/last-day-of-the-month dt))
start-of-last-week (- last-of-month 7)]
(cond
(> 8 curr-day-of-month) :first
(< start-of-last-week curr-day-of-month) :last
:else :other))) | |
Triggers the sending of all pulses which are scheduled to run in the current hour | (jobs/defjob SendPulses [_]
(try
(task-history/with-task-history {:task "send-pulses"}
;; determine what time it is right now (hour-of-day & day-of-week) in reporting timezone
(let [reporting-timezone (driver/report-timezone)
now (if (empty? reporting-timezone)
(time/now)
(time/to-time-zone (time/now) (time/time-zone-for-id reporting-timezone)))
curr-hour (time/hour now)
;; joda time produces values of 1-7 here (Mon -> Sun) and we subtract 1 from it to
;; make the values zero based to correspond to the indexes in pulse-channel/days-of-week
curr-weekday (->> (dec (time/day-of-week now))
(get pulse-channel/days-of-week)
:id)
curr-monthday (monthday now)
curr-monthweek (monthweek now)]
(send-pulses! curr-hour curr-weekday curr-monthday curr-monthweek))
(clear-pulse-channels!))
(catch Throwable e
(log/error e "SendPulses task failed")))) |
(def ^:private send-pulses-job-key "metabase.task.send-pulses.job") (def ^:private send-pulses-trigger-key "metabase.task.send-pulses.trigger") | |
(defmethod task/init! ::SendPulses [_]
(let [job (jobs/build
(jobs/of-type SendPulses)
(jobs/with-identity (jobs/key send-pulses-job-key)))
trigger (triggers/build
(triggers/with-identity (triggers/key send-pulses-trigger-key))
(triggers/start-now)
(triggers/with-schedule
(cron/schedule
;; run at the top of every hour
(cron/cron-schedule "0 0 * * * ? *")
;; If send-pulses! misfires, don't try to re-send all the misfired Pulses. Retry only the most
;; recent misfire, discarding all others. This should hopefully cover cases where a misfire
;; happens while the system is still running; if the system goes down for an extended period of
;; time we don't want to re-send tons of (possibly duplicate) Pulses.
;;
;; See https://www.nurkiewicz.com/2012/04/quartz-scheduler-misfire-instructions.html
(cron/with-misfire-handling-instruction-fire-and-proceed))))]
(task/schedule-task! job trigger))) | |
Scheduled tasks for syncing metadata/analyzing and caching FieldValues for connected Databases. There always UpdateFieldValues and SyncAndAnalyzeDatabase jobs present. Databases add triggers to these jobs. And those triggers include a database id. | (ns metabase.task.sync-databases
(:require
[clojurewerkz.quartzite.conversion :as qc]
[clojurewerkz.quartzite.jobs :as jobs]
[clojurewerkz.quartzite.schedule.cron :as cron]
[clojurewerkz.quartzite.triggers :as triggers]
[java-time.api :as t]
[malli.core :as mc]
[metabase.config :as config]
[metabase.db.query :as mdb.query]
[metabase.driver.h2 :as h2]
[metabase.driver.util :as driver.u]
[metabase.lib.schema.id :as lib.schema.id]
[metabase.models.database :as database :refer [Database]]
[metabase.models.interface :as mi]
[metabase.models.permissions :as perms]
[metabase.sync.analyze :as analyze]
[metabase.sync.field-values :as field-values]
[metabase.sync.schedules :as sync.schedules]
[metabase.sync.sync-metadata :as sync-metadata]
[metabase.task :as task]
[metabase.util :as u]
[metabase.util.cron :as u.cron]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.malli.registry :as mr]
[metabase.util.malli.schema :as ms]
[toucan2.core :as t2])
(:import
(org.quartz
CronTrigger
JobDetail
JobKey
TriggerKey))) |
(set! *warn-on-reflection* true) | |
+----------------------------------------------------------------------------------------------------------------+ | JOB LOGIC | +----------------------------------------------------------------------------------------------------------------+ | |
(declare unschedule-tasks-for-db!) | |
(mu/defn ^:private job-context->database-id :- [:maybe ::lib.schema.id/database] "Get the Database ID referred to in `job-context`." [job-context] (u/the-id (get (qc/from-job-data job-context) "db-id"))) | |
The DisallowConcurrentExecution on the two defrecords below attaches an annotation to the generated class that will constrain the job execution to only be one at a time. Other triggers wanting the job to run will misfire. | |
If the | (def ^:private analyze-duration-threshold-for-refingerprinting 5) |
Whether to refingerprint fields in the database. Looks at the runtime of the last analysis and if any fields were fingerprinted. If no fields were fingerprinted and the run was shorter than the threshold, it will re-fingerprint some fields. | (defn- should-refingerprint-fields?
[{:keys [start-time end-time steps] :as _analyze-results}]
(let [attempted (some->> steps
(filter (fn [[step-name _results]] (= step-name "fingerprint-fields")))
first
second
:fingerprints-attempted)]
(and (number? attempted)
(zero? attempted)
start-time
end-time
(< (.toMinutes (t/duration start-time end-time)) analyze-duration-threshold-for-refingerprinting)))) |
(defn- sync-and-analyze-database*!
[database-id]
(log/infof "Starting sync task for Database %d." database-id)
(when-let [database (or (t2/select-one Database :id database-id)
(do
(unschedule-tasks-for-db! (mi/instance Database {:id database-id}))
(log/warnf "Cannot sync Database %d: Database does not exist." database-id)))]
(if-let [ex (try
;; it's okay to allow testing H2 connections during sync. We only want to disallow you from testing them for the
;; purposes of creating a new H2 database.
(binding [h2/*allow-testing-h2-connections* true]
(driver.u/can-connect-with-details? (:engine database) (:details database) :throw-exceptions))
nil
(catch Throwable e
e))]
(log/warnf ex "Cannot sync Database %s: %s" (:name database) (ex-message ex))
(do
(sync-metadata/sync-db-metadata! database)
;; only run analysis if this is a "full sync" database
(when (:is_full_sync database)
(let [results (analyze/analyze-db! database)]
(when (and (:refingerprint database) (should-refingerprint-fields? results))
(analyze/refingerprint-db! database)))))))) | |
The sync and analyze database job, as a function that can be used in a test | (defn- sync-and-analyze-database!
[job-context]
(when-let [database-id (job-context->database-id job-context)]
(if (= perms/audit-db-id database-id)
(do
(log/warn "Cannot sync Database: It is the audit db.")
(when-not config/is-prod?
(throw (ex-info "Cannot sync Database: It is the audit db."
{:database-id database-id
:raw-job-context job-context
:job-context (pr-str job-context)}))))
(sync-and-analyze-database*! database-id)))) |
Sync and analyze the database | (jobs/defjob ^{org.quartz.DisallowConcurrentExecution true
:doc }
SyncAndAnalyzeDatabase [job-context]
(sync-and-analyze-database! job-context)) |
The update field values job, as a function that can be used in a test | (defn- update-field-values!
[job-context]
(when-let [database-id (job-context->database-id job-context)]
(log/infof "Update Field values task triggered for Database %d." database-id)
(when-let [database (or (t2/select-one Database :id database-id)
(do
(unschedule-tasks-for-db! (mi/instance Database {:id database-id}))
(log/warnf "Cannot update Field values for Database %d: Database does not exist." database-id)))]
(if (:is_full_sync database)
(field-values/update-field-values! database)
(log/infof "Skipping update, automatic Field value updates are disabled for Database %d." database-id))))) |
Update field values | (jobs/defjob ^{org.quartz.DisallowConcurrentExecution true
:doc }
UpdateFieldValues [job-context]
(update-field-values! job-context)) |
+----------------------------------------------------------------------------------------------------------------+ | TASK INFO AND GETTER FUNCTIONS | +----------------------------------------------------------------------------------------------------------------+ | |
(mr/def ::class
[:fn {:error/message "a Class"} class?]) | |
One-off schema for information about the various sync tasks we run for a DB. | (def ^:private TaskInfo [:map [:key :keyword] [:db-schedule-column :keyword] [:job-class ::class]]) |
(def ^:private sync-analyze-task-info
{:key :sync-and-analyze
:db-schedule-column :metadata_sync_schedule
:job-class SyncAndAnalyzeDatabase}) | |
(assert (mc/validate TaskInfo sync-analyze-task-info)) | |
(def ^:private field-values-task-info
{:key :update-field-values
:db-schedule-column :cache_field_values_schedule
:job-class UpdateFieldValues}) | |
(assert (mc/validate TaskInfo field-values-task-info)) | |
These getter functions are not strictly necessary but are provided primarily so we can get some extra validation by using them | |
(mu/defn ^:private job-key :- (ms/InstanceOfClass JobKey) "Return an appropriate string key for the job described by `task-info` for `database-or-id`." ^JobKey [task-info :- TaskInfo] (jobs/key (format "metabase.task.%s.job" (name (:key task-info))))) | |
(mu/defn ^:private trigger-key :- (ms/InstanceOfClass TriggerKey)
"Return an appropriate string key for the trigger for `task-info` and `database-or-id`."
^TriggerKey [database :- (ms/InstanceOf Database)
task-info :- TaskInfo]
(triggers/key (format "metabase.task.%s.trigger.%d" (name (:key task-info)) (u/the-id database)))) | |
(mu/defn ^:private cron-schedule :- u.cron/CronScheduleString "Fetch the appropriate cron schedule string for `database` and `task-info`." [database :- (ms/InstanceOf Database) task-info :- TaskInfo] (get database (:db-schedule-column task-info))) | |
(mu/defn ^:private job-class :- ::class "Get the Job class for `task-info`." [task-info :- TaskInfo] (:job-class task-info)) | |
(mu/defn ^:private trigger-description :- :string "Return an appropriate description string for a job/trigger for Database described by `task-info`." [database :- (ms/InstanceOf Database) task-info :- TaskInfo] (format "%s Database %d" (name (:key task-info)) (u/the-id database))) | |
(mu/defn ^:private job-description :- :string "Return an appropriate description string for a job" [task-info :- TaskInfo] (format "%s for all databases" (name (:key task-info)))) | |
+----------------------------------------------------------------------------------------------------------------+ | DELETING TASKS FOR A DB | +----------------------------------------------------------------------------------------------------------------+ | |
Cancel a single sync task for | (mu/defn ^:private delete-task!
[database :- (ms/InstanceOf Database)
task-info :- TaskInfo]
(let [trigger-key (trigger-key database task-info)]
(log/debug (u/format-color 'red
(format "Unscheduling task for Database %d: trigger: %s" (u/the-id database) (.getName trigger-key))))
(task/delete-trigger! trigger-key))) |
Cancel all scheduled sync and FieldValues caching tasks for | (mu/defn unschedule-tasks-for-db!
[database :- (ms/InstanceOf Database)]
(doseq [task [sync-analyze-task-info field-values-task-info]]
(delete-task! database task))) |
+----------------------------------------------------------------------------------------------------------------+ | (RE)SCHEDULING TASKS FOR A DB | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn ^:private job :- (ms/InstanceOfClass JobDetail) "Build a durable Quartz Job for `task-info`. Durable in Quartz allows the job to exist even if there are no triggers for it." ^JobDetail [task-info :- TaskInfo] (jobs/build (jobs/with-description (job-description task-info)) (jobs/of-type (job-class task-info)) (jobs/with-identity (job-key task-info)) (jobs/store-durably))) | |
(def ^:private sync-analyze-job (job sync-analyze-task-info)) (def ^:private field-values-job (job field-values-task-info)) | |
(mu/defn ^:private trigger :- (ms/InstanceOfClass CronTrigger)
"Build a Quartz Trigger for `database` and `task-info`."
^CronTrigger [database :- (ms/InstanceOf Database)
task-info :- TaskInfo]
(triggers/build
(triggers/with-description (trigger-description database task-info))
(triggers/with-identity (trigger-key database task-info))
(triggers/using-job-data {"db-id" (u/the-id database)})
(triggers/for-job (job-key task-info))
(triggers/start-now)
(triggers/with-schedule
(cron/schedule
(cron/cron-schedule (cron-schedule database task-info))
;; if we miss a sync for one reason or another (such as system being down) do not try to run the sync again.
;; Just wait until the next sync cycle.
;;
;; See https://www.nurkiewicz.com/2012/04/quartz-scheduler-misfire-instructions.html for more info
(cron/with-misfire-handling-instruction-do-nothing))))) | |
Schedule a new Quartz job for called [[from metabase.models.database/schedule-tasks!]] from the post-insert and the pre-update | (mu/defn check-and-schedule-tasks-for-db!
[database :- (ms/InstanceOf Database)]
(if (= perms/audit-db-id (:id database))
(log/info (u/format-color :red "Not scheduling tasks for audit database"))
(let [sync-job (task/job-info (job-key sync-analyze-task-info))
fv-job (task/job-info (job-key field-values-task-info))
sync-trigger (trigger database sync-analyze-task-info)
fv-trigger (trigger database field-values-task-info)
existing-sync-trigger (some (fn [trigger] (when (= (:key trigger) (.. sync-trigger getKey getName))
trigger))
(:triggers sync-job))
existing-fv-trigger (some (fn [trigger] (when (= (:key trigger) (.. fv-trigger getKey getName))
trigger))
(:triggers fv-job))
jobs-to-create [{:existing-trigger existing-sync-trigger
:existing-schedule (:metadata_sync_schedule database)
:ti sync-analyze-task-info
:trigger sync-trigger
:description "sync/analyze"}
{:existing-trigger existing-fv-trigger
:existing-schedule (:cache_field_values_schedule database)
:ti field-values-task-info
:trigger fv-trigger
:description "field-values"}]]
(doseq [{:keys [existing-trigger existing-schedule ti trigger description]} jobs-to-create
:when (or (not existing-trigger)
(not= (:schedule existing-trigger) existing-schedule))]
(delete-task! database ti)
(log/info
(u/format-color :green "Scheduling %s for database %d: trigger: %s"
description (:id database) (.. ^org.quartz.Trigger trigger getKey getName)))
;; now (re)schedule the task
(task/add-trigger! trigger))))) |
+----------------------------------------------------------------------------------------------------------------+ | TASK INITIALIZATION | +----------------------------------------------------------------------------------------------------------------+ | |
Separated from | (defn- job-init [] (task/add-job! sync-analyze-job) (task/add-job! field-values-job)) |
Predicate returning if the user does not manually set sync schedules and leaves it to metabase. | (defn- metabase-controls-schedule? [database] (not (-> database :details :let-user-control-scheduling))) |
(defn- randomize-db-schedules-if-needed
[]
;; todo: when we can use json operations on h2 we can check details in the query and drop the transducer
(transduce (comp (map (partial mi/do-after-select Database))
(filter metabase-controls-schedule?))
(fn
([] 0)
([counter]
(log/info "Updated default schedules for %d databases" counter)
counter)
([counter db]
(try
(t2/update! Database (u/the-id db)
(sync.schedules/schedule-map->cron-strings
(sync.schedules/default-randomized-schedule)))
(inc counter)
(catch Exception e
(log/warnf e
"Error updating database %d for randomized schedules"
(u/the-id db))
counter))))
(mdb.query/reducible-query
{:select [:id :details]
:from [:metabase_database]
:where [:or
[:in
:metadata_sync_schedule
sync.schedules/default-metadata-sync-schedule-cron-strings]
[:in
:cache_field_values_schedule
sync.schedules/default-cache-field-values-schedule-cron-strings]]}))) | |
(defmethod task/init! ::SyncDatabases [_] (job-init) (randomize-db-schedules-if-needed)) | |
(ns metabase.task.task-history-cleanup (:require [clojurewerkz.quartzite.jobs :as jobs] [clojurewerkz.quartzite.schedule.cron :as cron] [clojurewerkz.quartzite.triggers :as triggers] [metabase.models.task-history :as task-history] [metabase.task :as task] [metabase.util.log :as log])) | |
(set! *warn-on-reflection* true) | |
Maximum number of TaskHistory rows. | (def ^:private history-rows-to-keep 100000) |
Delete older TaskHistory rows -- see docstring of | (defn- task-history-cleanup!
[]
(log/debug "Cleaning up task history")
(task-history/with-task-history {:task "task-history-cleanup"}
(let [deleted-rows? (task-history/cleanup-task-history! history-rows-to-keep)]
(log/debug
(if deleted-rows?
"Task history cleanup successful, rows were deleted"
"Task history cleanup successful, no rows were deleted"))))) |
Delete older TaskHistory rows -- see docstring of | (jobs/defjob TaskHistoryCleanup [_] (task-history-cleanup!)) |
(def ^:private job-key "metabase.task.task-history-cleanup.job") (def ^:private trigger-key "metabase.task.task-history-cleanup.trigger") | |
(defmethod task/init! ::TaskHistoryCleanup [_]
(let [job (jobs/build
(jobs/of-type TaskHistoryCleanup)
(jobs/with-identity (jobs/key job-key)))
trigger (triggers/build
(triggers/with-identity (triggers/key trigger-key))
(triggers/start-now)
(triggers/with-schedule
;; run every day at midnight
(cron/cron-schedule "0 0 0 * * ? *")))]
(task/schedule-task! job trigger))) | |
Tasks for truncating audit-related tables, particularly | (ns metabase.task.truncate-audit-tables
(:require
[clojurewerkz.quartzite.jobs :as jobs]
[clojurewerkz.quartzite.schedule.cron :as cron]
[clojurewerkz.quartzite.triggers :as triggers]
[java-time.api :as t]
[metabase.config :as config]
[metabase.models.setting :as setting :refer [defsetting]]
[metabase.models.task-history :as task-history]
[metabase.plugins.classloader :as classloader]
[metabase.public-settings.premium-features
:as premium-features
:refer [defenterprise]]
[metabase.task :as task]
[metabase.util.i18n :as i18n :refer [deferred-tru]]
[metabase.util.log :as log]
[toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
Load EE implementation if available | (when config/ee-available? (classloader/require 'metabase-enterprise.task.truncate-audit-tables)) |
Minimum allowed value for | (def min-retention-days 30) |
Default value for | (def default-retention-days 720) |
Logs a warning that the value for | (defn log-minimum-value-warning
[env-var-value]
(log/warnf "MB_AUDIT_MAX_RETENTION_DAYS is set to %d; using the minimum value of %d instead."
env-var-value
min-retention-days)) |
(defsetting audit-max-retention-days
(deferred-tru "Number of days to retain data in audit-related tables. Minimum value is 30; set to 0 to retain data indefinitely.")
:visibility :internal
:setter :none
:audit :never
:getter (fn []
(let [env-var-value (setting/get-value-of-type :integer :audit-max-retention-days)]
(def env-var-value env-var-value)
(cond
(nil? env-var-value)
default-retention-days
;; Treat 0 as an alias for infinity
(zero? env-var-value)
##Inf
(< env-var-value min-retention-days)
(do
(log-minimum-value-warning env-var-value)
min-retention-days)
:else
env-var-value)))) | |
Given a model, deletes all rows older than the configured threshold | (defn- truncate-table!
[model time-column]
(when-not (infinite? (audit-max-retention-days))
(let [table-name (name (t2/table-name model))]
(task-history/with-task-history {:task "task-history-cleanup"}
(try
(log/infof "Cleaning up %s table" table-name)
(let [rows-deleted (t2/delete!
model
time-column
[:<= (t/minus (t/offset-date-time) (t/days (audit-max-retention-days)))])]
(if (> rows-deleted 0)
(log/infof "%s cleanup successful, %d rows were deleted" table-name rows-deleted)
(log/infof "%s cleanup successful, no rows were deleted" table-name)))
(catch Throwable e
(log/errorf e "%s cleanup failed" table-name))))))) |
List of models to truncate. OSS implementation only truncates | (defenterprise audit-models-to-truncate
metabase-enterprise.task.truncate-audit-tables
[]
[{:model :model/QueryExecution :timestamp-col :started_at}]) |
(defn- truncate-audit-tables!
[]
(run!
(fn [{:keys [model timestamp-col]}]
(truncate-table! model timestamp-col))
(audit-models-to-truncate))) | |
Triggers the removal of | (jobs/defjob TruncateAuditTables [_] (truncate-audit-tables!)) |
(def ^:private truncate-audit-tables-job-key "metabase.task.truncate-audit-tables.job") (def ^:private truncate-audit-tables-trigger-key "metabase.task.truncate-audit-tables.trigger") (def ^:private truncate-audit-tables-cron "0 0 */12 * * ? *") ;; Run every 12 hours | |
Run every 12 hours | |
(defmethod task/init! ::TruncateAuditTables [_]
(let [job (jobs/build
(jobs/of-type TruncateAuditTables)
(jobs/with-identity (jobs/key truncate-audit-tables-job-key)))
trigger (triggers/build
(triggers/with-identity (triggers/key truncate-audit-tables-trigger-key))
(triggers/start-now)
(triggers/with-schedule
(cron/schedule
(cron/cron-schedule truncate-audit-tables-cron)
(cron/with-misfire-handling-instruction-do-nothing))))]
(task/schedule-task! job trigger))) | |
Contains a Metabase task which periodically checks for the availability of new Metabase versions. | (ns metabase.task.upgrade-checks (:require [cheshire.core :as json] [clj-http.client :as http] [clojurewerkz.quartzite.jobs :as jobs] [clojurewerkz.quartzite.schedule.cron :as cron] [clojurewerkz.quartzite.triggers :as triggers] [java-time.api :as t] [metabase.config :as config] [metabase.public-settings :as public-settings] [metabase.task :as task] [metabase.util.log :as log])) |
(set! *warn-on-reflection* true) | |
(defn- get-version-info []
(let [version-info-url-key (if config/ee-available? :mb-version-info-ee-url :mb-version-info-url)
version-info-url (config/config-str version-info-url-key)
{:keys [status body]} (http/get version-info-url (merge
{:content-type "application/json"}
(when config/is-prod?
{:query-params {"instance" (public-settings/site-uuid-for-version-info-fetching)}})))]
(when (not= status 200)
(throw (Exception. (format "[%d]: %s" status body))))
(json/parse-string body keyword))) | |
Simple job which looks up all databases and runs a sync on them | (jobs/defjob CheckForNewVersions [_]
(when (public-settings/check-for-updates)
(log/debug "Checking for new Metabase version info.")
(try
;; TODO: add in additional request params if anonymous tracking is enabled
(public-settings/version-info-last-checked! (t/zoned-date-time))
(when-let [version-info (get-version-info)]
(public-settings/version-info! version-info))
(catch Throwable e
(log/error e "Error fetching version info; setting version-info value to nil")
(public-settings/version-info! nil))))) |
(def ^:private job-key "metabase.task.upgrade-checks.job") (def ^:private trigger-key "metabase.task.upgrade-checks.trigger") | |
(defmethod task/init! ::CheckForNewVersions [_]
(let [job (jobs/build
(jobs/of-type CheckForNewVersions)
(jobs/with-identity (jobs/key job-key)))
trigger (triggers/build
(triggers/with-identity (triggers/key trigger-key))
(triggers/start-now)
(triggers/with-schedule
;; run twice a day
(cron/cron-schedule "0 15 6,18 * * ? *")))]
(task/schedule-task! job trigger))) | |
(ns metabase.transforms.core
(:require
[medley.core :as m]
[metabase.domain-entities.core
:as de
:refer [Bindings DimensionBindings SourceEntity SourceName]]
[metabase.domain-entities.specs
:refer [domain-entity-specs DomainEntitySpec]]
[metabase.driver :as driver]
[metabase.mbql.schema :as mbql.s]
[metabase.mbql.util :as mbql.u]
[metabase.models.field :refer [Field]]
[metabase.models.interface :as mi]
[metabase.models.table :as table :refer [Table]]
[metabase.query-processor :as qp]
[metabase.transforms.materialize :as tf.materialize]
[metabase.transforms.specs :refer [Step transform-specs TransformSpec]]
[metabase.util :as u]
[metabase.util.i18n :refer [tru]]
#_{:clj-kondo/ignore [:deprecated-namespace]}
[metabase.util.schema :as su]
[schema.core :as s]
[toucan2.core :as t2])) | |
(s/defn ^:private add-bindings :- Bindings
[bindings :- Bindings, source :- SourceName, new-bindings :- (s/maybe DimensionBindings)]
(reduce-kv (fn [bindings name definition]
(->> definition
(de/resolve-dimension-clauses bindings source)
(assoc-in bindings [source :dimensions name])))
bindings
new-bindings)) | |
(defn- mbql-reference->col-name
[field-clause]
(mbql.u/match-one field-clause
[:field (field-name :guard string?) _]
field-name
[:field (id :guard integer?) _]
(t2/select-one-fn :name Field :id id))) | |
(s/defn ^:private infer-resulting-dimensions :- DimensionBindings
[bindings :- Bindings
{:keys [joins name]} :- Step
query :- (s/pred mbql.s/valid-query?)]
(let [flattened-bindings (merge (apply merge (map (comp :dimensions bindings :source) joins))
(get-in bindings [name :dimensions]))]
(into {} (for [{:keys [name] :as col} (qp/query->expected-cols query)]
[(if (flattened-bindings name)
name
;; If the col is not one of our own we have to reconstruct to what it refers in
;; our parlance
(or (some->> flattened-bindings
(m/find-first (comp #{name} mbql-reference->col-name))
key)
;; If that doesn't work either, it's a duplicated col from a join
name))
(de/mbql-reference col)])))) | |
(defn- maybe-add-fields
[bindings {:keys [aggregation source]} query]
(if-not aggregation
(assoc query :fields (vals (get-in bindings [source :dimensions])))
query)) | |
(defn- maybe-add-expressions
[bindings {:keys [expressions name]} query]
(if expressions
(-> query
(assoc :expressions (->> expressions
keys
(select-keys (get-in bindings [name :dimensions]))))
(update :fields concat (for [expression (keys expressions)]
[:expression expression])))
query)) | |
(defn- maybe-add-aggregation
[bindings {:keys [name aggregation]} query]
(->> (for [agg (keys aggregation)]
[:aggregation-options (get-in bindings [name :dimensions agg]) {:name agg}])
not-empty
(m/assoc-some query :aggregation))) | |
(defn- maybe-add-breakout
[bindings {:keys [name breakout]} query]
(m/assoc-some query :breakout (not-empty
(for [breakout breakout]
(de/resolve-dimension-clauses bindings name breakout))))) | |
Serialize | (s/defn ^:private ->source-table-reference
[entity :- SourceEntity]
(if (mi/instance-of? Table entity)
(u/the-id entity)
(str "card__" (u/the-id entity)))) |
(defn- maybe-add-joins
[bindings {context-source :source joins :joins} query]
(m/assoc-some query :joins
(not-empty
(for [{:keys [source condition strategy]} joins]
(-> {:condition (de/resolve-dimension-clauses bindings context-source condition)
:source-table (-> source bindings :entity ->source-table-reference)
:alias source
:fields :all}
(m/assoc-some :strategy strategy)))))) | |
(defn- maybe-add-filter
[bindings {:keys [name filter]} query]
(m/assoc-some query :filter (de/resolve-dimension-clauses bindings name filter))) | |
(defn- maybe-add-limit
[_bindings {:keys [limit]} query]
(m/assoc-some query :limit limit)) | |
(s/defn ^:private transform-step! :- Bindings
[bindings :- Bindings, {:keys [name source aggregation expressions] :as step} :- Step]
(let [source-entity (get-in bindings [source :entity])
local-bindings (-> bindings
(add-bindings name (get-in bindings [source :dimensions]))
(add-bindings name expressions)
(add-bindings name aggregation))
query {:type :query
:query (->> {:source-table (->source-table-reference source-entity)}
(maybe-add-fields local-bindings step)
(maybe-add-expressions local-bindings step)
(maybe-add-aggregation local-bindings step)
(maybe-add-breakout local-bindings step)
(maybe-add-joins local-bindings step)
(maybe-add-filter local-bindings step)
(maybe-add-limit local-bindings step))
:database ((some-fn :db_id :database_id) source-entity)}]
(assoc bindings name {:entity (tf.materialize/make-card-for-step! step query)
:dimensions (infer-resulting-dimensions local-bindings step query)}))) | |
(def ^:private Tableset
#_{:clj-kondo/ignore [:deprecated-var]}
[(mi/InstanceOf:Schema Table)]) | |
(s/defn ^:private find-tables-with-domain-entity :- Tableset [tableset :- Tableset, domain-entity-spec :- DomainEntitySpec] (filter #(-> % :domain_entity :type (isa? (:type domain-entity-spec))) tableset)) | |
(s/defn ^:private tableset->bindings :- Bindings
[tableset :- Tableset]
(into {} (for [{{domain-entity-name :name dimensions :dimensions} :domain_entity :as table} tableset]
[domain-entity-name
{:dimensions (m/map-vals de/mbql-reference dimensions)
:entity table}]))) | |
(s/defn ^:private apply-transform-to-tableset! :- Bindings
[tableset :- Tableset, {:keys [steps _provides]} :- TransformSpec]
(driver/with-driver (-> tableset first table/database :engine)
(reduce transform-step! (tableset->bindings tableset) (vals steps)))) | |
(s/defn ^:private resulting-entities :- [SourceEntity]
[bindings :- Bindings, {:keys [provides]} :- TransformSpec]
(map (comp :entity val) (select-keys bindings provides))) | |
(s/defn ^:private validate-results :- Bindings
[bindings :- Bindings, {:keys [provides]} :- TransformSpec]
(doseq [domain-entity-name provides]
(assert (de/satisfies-requierments? (get-in bindings [domain-entity-name :entity])
(@domain-entity-specs domain-entity-name))
(str (tru "Resulting transforms do not conform to expectations.\nExpected: {0}"
domain-entity-name))))
bindings) | |
(s/defn ^:private tables-matching-requirements :- (s/maybe Tableset)
[tableset :- Tableset, {:keys [requires]} :- TransformSpec]
(let [matches (map (comp (partial find-tables-with-domain-entity tableset)
@domain-entity-specs)
requires)]
(when (every? (comp #{1} count) matches)
(map first matches)))) | |
(s/defn ^:private tableset :- Tableset
[db-id :- su/IntGreaterThanZero, schema :- (s/maybe s/Str)]
(table/with-fields
(de/with-domain-entity
(t2/select 'Table :db_id db-id :schema schema)))) | |
Apply transform defined by transform spec The algorithm is as follows: 1) Try to find a set of tables in the given schema that have required domain entities. 2) If found, use these tables and their fields as the initial bindings. 3) Go through the transform steps, materialize them as cards, and accure these and their result cols to the bindings. 4) Check that all output cards have the expected result shape. 5) Return the output cards. | (s/defn apply-transform!
[db-id :- su/IntGreaterThanZero, schema :- (s/maybe s/Str), spec :- TransformSpec]
(tf.materialize/fresh-collection-for-transform! spec)
(some-> (tableset db-id schema)
(tables-matching-requirements spec)
(apply-transform-to-tableset! spec)
(validate-results spec)
(resulting-entities spec))) |
Return a list of candidate transforms for a given table. | (defn candidates
[table]
(filter (comp (partial some (comp #{(u/the-id table)} u/the-id))
(partial tables-matching-requirements (tableset (:db_id table) (:schema table))))
@transform-specs)) |
(ns metabase.transforms.dashboard (:require [medley.core :as m] [metabase.api.common :as api] [metabase.automagic-dashboards.populate :as populate] [metabase.models.table :refer [Table]] [metabase.transforms.materialize :as tf.materialize] [metabase.transforms.specs :refer [transform-specs]] [metabase.util :as u] [toucan2.core :as t2] [toucan2.realize :as t2.realize])) | |
(def ^:private ^:const ^Long width 12) (def ^:private ^:const ^Long total-width 18) (def ^:private ^:const ^Long height 4) | |
Build a section of cards and format them according to what the automagic dashboards code expects. | (defn- cards->section
[group cards]
(mapcat (fn [{:keys [name description display] :as card}]
(cond-> [(assoc card
:group group
:width width
:height height
:card-score 100
:title name
:visualization [display]
:position 0)]
description (conj {:text description
:group group
:width (- total-width width)
:height height
:card-score 100
:position 0})))
cards)) |
(defn- card-for-source-table
[table]
{:pre [(map? table)]}
{:creator_id api/*current-user-id*
:dataset_query {:type :query
:query {:source-table (u/the-id table)}
:database (:db_id table)}
:name (:display_name table)
:collection_id nil
:visualization_settings {}
:display :table}) | |
(defn- sources [steps]
(when-let [table-ids (->> steps
(map (comp :source-table :query :dataset_query))
(filter number?)
not-empty)]
(let [table-id->table (t2/select-pk->fn t2.realize/realize Table :id [:in (set table-ids)])]
(mapv (fn [table-id]
(let [table (get table-id->table table-id)]
(card-for-source-table table)))
table-ids)))) | |
Create a (transient) dashboard for transform named | (defn dashboard
[transform-name]
(let [transform-spec (m/find-first (comp #{transform-name} :name) @transform-specs)
{steps false provides true} (->> transform-name
tf.materialize/get-collection
(t2/select 'Card :collection_id)
(group-by (comp some?
(-> transform-spec :provides set)
:name)))
sources (sources steps)]
(populate/create-dashboard {:cards (concat (cards->section "sources" sources)
(cards->section "steps" steps)
(cards->section "provides" provides))
:title (str transform-name " automatically generated transform")
:description (:description transform-spec)
:groups {"sources" {:title "Sources"}
"steps" {:title "Steps"}
"provides" {:title "Resulting datasets"}}}))) |
(ns metabase.transforms.materialize (:require [metabase.api.common :as api] [metabase.models.card :as card :refer [Card]] [metabase.models.collection :as collection :refer [Collection]] [metabase.query-processor :as qp] [toucan2.core :as t2])) | |
(declare get-or-create-root-container-collection!) | |
(defn- root-container-location
[]
(collection/children-location
(t2/select-one [Collection :location :id]
:id (get-or-create-root-container-collection!)))) | |
Get collection named | (defn get-collection
([collection-name]
(get-collection collection-name (root-container-location)))
([collection-name location]
(t2/select-one-pk Collection
:name collection-name
:location location))) |
(defn- create-collection!
([collection-name description]
(create-collection! collection-name description (root-container-location)))
([collection-name description location]
(first (t2/insert-returning-pks! Collection
{:name collection-name
:description description
:location location})))) | |
Get or create container collection for transforms in the root collection. | (defn- get-or-create-root-container-collection!
[]
(let [location "/"
name "Automatically Generated Transforms"]
(or (get-collection name location)
(create-collection! name nil location)))) |
Create a new collection for all the artefacts belonging to transform, or reset it if it already exists. | (defn fresh-collection-for-transform!
[{:keys [name description]}]
(if-let [collection-id (get-collection name)]
(t2/delete! Card :collection_id collection-id)
(create-collection! name description))) |
Make and save a card for a given transform step and query. | (defn make-card-for-step!
[{:keys [name transform description]} query]
(->> {:creator_id api/*current-user-id*
:dataset_query query
:description description
:name name
:collection_id (get-collection transform)
:result_metadata (qp/query->expected-cols query)
:visualization_settings {}
:display :table}
card/populate-query-fields
(t2/insert-returning-instances! Card)
first)) |
(ns metabase.transforms.specs
(:require
[medley.core :as m]
[metabase.domain-entities.specs :refer [FieldType MBQL]]
[metabase.mbql.normalize :as mbql.normalize]
[metabase.mbql.schema :as mbql.s]
[metabase.mbql.util :as mbql.u]
[metabase.util :as u]
#_{:clj-kondo/ignore [:deprecated-namespace]}
[metabase.util.schema :as su]
[metabase.util.yaml :as yaml]
[schema.coerce :as sc]
[schema.core :as s])) | |
(def ^:private Source s/Str) | |
(def ^:private Dimension s/Str) | |
(def ^:private Breakout [MBQL]) | |
(def ^:private Aggregation {Dimension MBQL}) | |
(def ^:private Expressions {Dimension MBQL}) | |
(def ^:private Description s/Str) | |
(def ^:private Filter MBQL) | |
(def ^:private Limit su/IntGreaterThanZero) | |
(def ^:private JoinStrategy (apply s/enum mbql.s/join-strategies)) | |
(def ^:private Joins [{(s/required-key :source) Source
(s/required-key :condition) MBQL
(s/optional-key :strategy) JoinStrategy}]) | |
(def ^:private TransformName s/Str) | |
Transform step | (def Step
{(s/required-key :source) Source
(s/required-key :name) Source
(s/required-key :transform) TransformName
(s/optional-key :aggregation) Aggregation
(s/optional-key :breakout) Breakout
(s/optional-key :expressions) Expressions
(s/optional-key :joins) Joins
(s/optional-key :description) Description
(s/optional-key :limit) Limit
(s/optional-key :filter) Filter}) |
(def ^:private Steps {Source Step}) | |
(def ^:private DomainEntity s/Str) | |
(def ^:private Requires [DomainEntity]) | |
(def ^:private Provides [DomainEntity]) | |
Transform spec | (def TransformSpec
{(s/required-key :name) TransformName
(s/required-key :requires) Requires
(s/required-key :provides) Provides
(s/required-key :steps) Steps
(s/optional-key :description) Description}) |
(defn- extract-dimensions [mbql] (mbql.u/match (mbql.normalize/normalize mbql) [:dimension dimension & _] dimension)) | |
(def ^:private ^{:arglists '([m])} stringify-keys
(partial m/map-keys name)) | |
(defn- add-metadata-to-steps
[spec]
(update spec :steps (partial m/map-kv-vals (fn [step-name step]
(assoc step
:name step-name
:transform (:name spec)))))) | |
(def ^:private transform-spec-parser
(sc/coercer!
TransformSpec
{MBQL mbql.normalize/normalize
Steps (fn [steps]
(->> steps
stringify-keys
(u/topological-sort (fn [{:keys [source joins]}]
(conj (map :source joins) source)))))
Breakout (fn [breakouts]
(for [breakout (u/one-or-many breakouts)]
(if (s/check MBQL breakout)
[:dimension breakout]
breakout)))
FieldType (partial keyword "type")
[DomainEntity] u/one-or-many
JoinStrategy keyword
;; Since `Aggregation` and `Expressions` are structurally the same, we can't use them directly
{Dimension MBQL} (comp (partial u/topological-sort extract-dimensions)
stringify-keys)
;; Some map keys are names (ie. strings) while the rest are keywords, a distinction lost in YAML
s/Str name})) | |
(def ^:private transforms-dir "transforms/") | |
List of registered dataset transforms. | (def transform-specs (delay (yaml/load-dir transforms-dir (comp transform-spec-parser add-metadata-to-steps)))) |
(ns metabase.troubleshooting (:require [metabase.analytics.stats :as stats] [metabase.config :as config] [metabase.db :as mdb] [metabase.driver :as driver] [toucan2.core :as t2])) | |
(set! *warn-on-reflection* true) | |
System info we ask for for bug reports | (defn system-info
[]
(into (sorted-map)
(select-keys (System/getProperties) ["java.runtime.name"
"java.runtime.version"
"java.vendor"
"java.vendor.url"
"java.version"
"java.vm.name"
"java.vm.version"
"os.name"
"os.version"
"user.language"
"user.timezone"
"file.encoding"]))) |
Make it easy for the user to tell us what they're using | (defn metabase-info
[]
{:databases (->> (t2/select 'Database) (map :engine) distinct)
:hosting-env (stats/environment-type)
:application-database (mdb/db-type)
:application-database-details (t2/with-connection [^java.sql.Connection conn]
(let [metadata (.getMetaData conn)]
{:database {:name (.getDatabaseProductName metadata)
:version (.getDatabaseProductVersion metadata)}
:jdbc-driver {:name (.getDriverName metadata)
:version (.getDriverVersion metadata)}}))
:run-mode (config/config-kw :mb-run-mode)
:version config/mb-version-info
:settings {:report-timezone (driver/report-timezone)}}) |
(ns metabase.types.coercion-hierarchies (:require [clojure.set :as set])) | |
these need to be defonce so we don't drop our hierarchies, but defonce doesn't support docstrings: https://clojure.atlassian.net/browse/CLJ-1148 | |
Map of | (defonce ^:private
strategy->allowed-base-types
(atom {})) |
Map of coercion strategy -> resulting effective-type | (defonce ^:private
strategy->effective-type
(atom {})) |
Map of base-type -> #{strategy} which are not inheritable. Eg, binary fields are marked | (defonce ^:private
non-descending-base-type->strategy
(atom {})) |
Get a map of strategies -> allowed-base-types. These must live outside of the hierarchy. | (defn non-descending-strategies [] @non-descending-base-type->strategy) |
Gets the effective type for strategy. Essentially a getter over the private strategy->effective-type. | (defn effective-type-for-strategy [strategy] (get @strategy->effective-type strategy)) |
Ensure x is a sequential collection. Copied from metabase.util as that namespace is not amenable to cljc. | (defn- one-or-many [x] (if ((some-fn sequential? set? nil?) x) x [x])) |
Define the | (defn define-types!
[coercion-strategy base-type-or-types effective-type]
(let [base-types (set (one-or-many base-type-or-types))]
(swap! strategy->allowed-base-types assoc coercion-strategy base-types))
(swap! strategy->effective-type assoc coercion-strategy effective-type)) |
Define coercion strategies that should not exist for all of the descendants of base-type-or-types. | (defn define-non-inheritable-type!
[coercion-strategy base-type-or-types effective-type]
(swap! non-descending-base-type->strategy
(partial merge-with set/union)
(zipmap (one-or-many base-type-or-types) (repeat #{coercion-strategy})))
(swap! strategy->effective-type assoc coercion-strategy effective-type)) |
(defn- build-hierarchy [pairs]
(reduce
(fn [h [tag parent]]
(derive h tag parent))
#?(:clj @#'clojure.core/global-hierarchy
:cljs @(#'clojure.core/get-global-hierarchy))
pairs)) | |
atom is nil => rebuild the hierarchy | |
(def ^:private base-type-hierarchy* (atom nil)) | |
The global hierarchy, with coercion strategies added as ancestors of their allowed base type(s). | (defn base-type-hierarchy
[]
(when-not @base-type-hierarchy*
(locking base-type-hierarchy*
(when-not @base-type-hierarchy*
(reset! base-type-hierarchy* (build-hierarchy (for [[strategy base-types] @strategy->allowed-base-types
base-type base-types]
[base-type strategy]))))))
@base-type-hierarchy*) |
(def ^:private effective-type-hierarchy* (atom nil)) | |
The global hierarchy, with coercion strategies added as children of their resulting effective type. | (defn effective-type-hierarchy
[]
(when-not @effective-type-hierarchy*
(locking effective-type-hierarchy*
(when-not @effective-type-hierarchy*
(reset! effective-type-hierarchy* (build-hierarchy (seq @strategy->effective-type))))))
@effective-type-hierarchy*) |
rebuild coercion hierarchies if the global hierarchy changes | (add-watch
#?(:clj #'clojure.core/global-hierarchy
:cljs (#'clojure.core/get-global-hierarchy))
::rebuild-hierarchies
(fn [_ _ old new]
(when-not (= old new)
(reset! base-type-hierarchy* nil)
(reset! effective-type-hierarchy* nil)))) |
rebuild coercion hierarchies if the type map atoms change | |
(add-watch
strategy->allowed-base-types
::rebuild-hierarchies
(fn [_ _ old new]
(when-not (= old new)
(reset! base-type-hierarchy* nil)))) | |
(add-watch
strategy->effective-type
::rebuild-hierarchies
(fn [_ _ old new]
(when-not (= old new)
(reset! effective-type-hierarchy* nil)))) | |
(ns metabase.upload (:require [clj-bom.core :as bom] [clojure.data :as data] [clojure.data.csv :as csv] [clojure.string :as str] [flatland.ordered.map :as ordered-map] [flatland.ordered.set :as ordered-set] [java-time.api :as t] [medley.core :as m] [metabase.analytics.snowplow :as snowplow] [metabase.api.common :as api] [metabase.driver :as driver] [metabase.driver.sync :as driver.s] [metabase.driver.util :as driver.u] [metabase.mbql.util :as mbql.u] [metabase.models :refer [Database]] [metabase.models.card :as card] [metabase.models.collection :as collection] [metabase.models.humanization :as humanization] [metabase.models.interface :as mi] [metabase.models.permissions :as perms] [metabase.models.table :as table] [metabase.public-settings :as public-settings] [metabase.public-settings.premium-features :as premium-features] [metabase.sync :as sync] [metabase.sync.sync-metadata.fields :as sync-fields] [metabase.sync.sync-metadata.tables :as sync-tables] [metabase.upload.parsing :as upload-parsing] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2]) (:import (java.io File))) | |
(set! *warn-on-reflection* true) | |
| |
Upload types form a DAG (directed acyclic graph) where each type can be coerced into any of its ancestors types. We parse each value in the CSV file to the most-specific possible type for each column. The most-specific possible type for a column is the lowest common ancestor of the types for each value in the column.
boolean float datetime offset-datetime | │ │ │ │ │ | int date | / \ | / \ | / \ |/ \ boolean-or-int auto-incrementing-int-pk
| |
(def ^:private type+parent-pairs
;; listed in depth-first order
'([::boolean-or-int ::boolean]
[::boolean-or-int ::int]
[::auto-incrementing-int-pk ::int]
[::int ::float]
[::date ::datetime]
[::boolean ::varchar-255]
[::offset-datetime ::varchar-255]
[::datetime ::varchar-255]
[::float ::varchar-255]
[::varchar-255 ::text])) | |
Returns the type of a column given the lowest common ancestor type of the values in the column. | (defn ^:private column-type
[type]
(case type
::boolean-or-int ::boolean
type)) |
(def ^:private type->parents
(reduce
(fn [m [type parent]]
(update m type conj parent))
{}
type+parent-pairs)) | |
All value types including the root type, ::text | (def ^:private value-types (conj (keys type->parents) ::text)) |
All column types | (def ^:private column-types (map column-type value-types)) |
(defn- bfs-ancestors [type]
(loop [visit (list type)
visited (ordered-set/ordered-set)]
(if (empty? visit)
visited
(let [parents (mapcat type->parents visit)]
(recur parents (into visited parents)))))) | |
A map from each type to an ordered set of its ancestors, in breadth-first order | (def ^:private type->bfs-ancestors
(into {} (for [type value-types]
[type (bfs-ancestors type)]))) |
[[value->type]] helpers | |
Returns a regex that matches the argument, with or without surrounding parentheses. | (defn- with-parens
[number-regex]
(re-pattern (str "(" number-regex ")|(\\(" number-regex "\\))"))) |
Returns a regex that matches a positive or negative number, including currency symbols | (defn- with-currency
[number-regex]
;; currency signs can be all over: $2, -$2, $-2, 2€
(re-pattern (str upload-parsing/currency-regex "?\\s*-?"
upload-parsing/currency-regex "?"
number-regex
"\\s*" upload-parsing/currency-regex "?"))) |
(defn- int-regex [number-separators]
(with-parens
(with-currency
(case number-separators
("." ".,") #"\d[\d,]*"
",." #"\d[\d.]*"
", " #"\d[\d \u00A0]*"
".’" #"\d[\d’]*")))) | |
(defn- float-regex [number-separators]
(with-parens
(with-currency
(case number-separators
("." ".,") #"\d[\d,]*\.\d+"
",." #"\d[\d.]*\,[\d]+"
", " #"\d[\d \u00A0]*\,[\d.]+"
".’" #"\d[\d’]*\.[\d.]+")))) | |
Returns true if the given body does not throw an exception. | (defmacro does-not-throw?
[body]
`(try
~body
true
(catch Throwable e#
false))) |
(defn- date-string? [s] (does-not-throw? (upload-parsing/parse-local-date s))) | |
(defn- datetime-string? [s] (does-not-throw? (upload-parsing/parse-local-datetime s))) | |
(defn- offset-datetime-string? [s] (does-not-throw? (upload-parsing/parse-offset-datetime s))) | |
(defn- boolean-string? [s] (boolean (re-matches #"(?i)true|t|yes|y|1|false|f|no|n|0" s))) | |
(defn- boolean-or-int-string? [s]
(boolean (#{"0" "1"} s))) | |
end [[value->type]] helpers | |
The most-specific possible type for a given value. Possibilities are:
NB: There are currently the following gotchas: 1. ints/floats are assumed to use the separators and decimal points corresponding to the locale defined in the application settings 2. 0 and 1 are assumed to be booleans, not ints. | (defn- value->type
[value {:keys [number-separators] :as _settings}]
(let [trimmed (str/trim value)]
(cond
(str/blank? value) nil
(boolean-or-int-string? trimmed) ::boolean-or-int
(boolean-string? trimmed) ::boolean
(offset-datetime-string? trimmed) ::offset-datetime
(datetime-string? trimmed) ::datetime
(date-string? trimmed) ::date
(re-matches (int-regex number-separators) trimmed) ::int
(re-matches (float-regex number-separators) trimmed) ::float
(<= (count trimmed) 255) ::varchar-255
:else ::text))) |
(defn- row->value-types [row settings] (map #(value->type % settings) row)) | |
(defn- lowest-common-member [[x & xs :as all-xs] ys]
(cond
(empty? all-xs) (throw (IllegalArgumentException. (tru "Could not find a common type for {0} and {1}" all-xs ys)))
(contains? ys x) x
:else (recur xs ys))) | |
(defn- lowest-common-ancestor [type-a type-b]
(cond
(nil? type-a) type-b
(nil? type-b) type-a
(= type-a type-b) type-a
(contains? (type->bfs-ancestors type-a) type-b) type-b
(contains? (type->bfs-ancestors type-b) type-a) type-a
:else (lowest-common-member (type->bfs-ancestors type-a) (type->bfs-ancestors type-b)))) | |
like map with two args except it continues to apply f until ALL of the colls are exhausted. if colls are of uneven length, nils are supplied. | (defn- map-with-nils
[f c1 c2]
(lazy-seq
(let [s1 (seq c1) s2 (seq c2)]
(when (or s1 s2)
(cons (f (first s1) (first s2))
(map-with-nils f (rest s1) (rest s2))))))) |
compares types-a and types-b pairwise, finding the lowest-common-ancestor for each pair. types-a and types-b can be different lengths. | (defn- coalesce-types [types-a types-b] (map-with-nils lowest-common-ancestor types-a types-b)) |
(defn- normalize-column-name
[raw-name]
(if (str/blank? raw-name)
"unnamed_column"
(u/slugify (str/trim raw-name)))) | |
The lower-case name of the auto-incrementing PK column. The actual name in the database could be in upper-case. | (def auto-pk-column-name "_mb_row_id") |
(defn- table-id->auto-pk-column [table-id]
(first (filter (fn [field]
(= (normalize-column-name (:name field)) auto-pk-column-name))
(t2/select :model/Field :table_id table-id :active true)))) | |
(mu/defn column-types-from-rows :- [:sequential (into [:enum] column-types)]
"Returns a sequence of types, given the unparsed rows in the CSV file"
[settings column-count rows]
(->> rows
(map #(row->value-types % settings))
(reduce coalesce-types (repeat column-count nil))
(map (fn [type]
;; if there's no values in the column, assume it's a string
(if (nil? type)
::text
(column-type type)))))) | |
Consumes the header and rows from a CSV file. Returns a map with two keys:
- The value of | (defn- detect-schema
[header rows]
(let [normalized-header (->> header
(map normalize-column-name))
unique-header (->> normalized-header
mbql.u/uniquify-names
(map keyword))
column-count (count normalized-header)
settings (upload-parsing/get-settings)
col-name+type-pairs (->> rows
(column-types-from-rows settings column-count)
(map vector unique-header))]
{:extant-columns (ordered-map/ordered-map col-name+type-pairs)
:generated-columns (ordered-map/ordered-map (keyword auto-pk-column-name) ::auto-incrementing-int-pk)})) |
+------------------+ | Parsing values | +------------------+ | |
Append the current datetime to the given name to create a unique table name. The resulting name will be short enough for the given driver (truncating the supplised | (defn- unique-table-name
[driver table-name]
(let [time-format "_yyyyMMddHHmmss"
acceptable-length (min (count table-name)
(- (driver/table-name-length-limit driver) (count time-format)))
truncated-name-without-time (subs (u/slugify table-name) 0 acceptable-length)]
(str truncated-name-without-time
(t/format time-format (t/local-date-time))))) |
Maximum number of values to use for detecting a column's type | (def ^:private max-sample-rows 1000) |
Returns an improper subset of the rows no longer than [[max-sample-rows]]. Takes an evenly-distributed sample (not just the first n). | (defn- sample-rows
[rows]
(take max-sample-rows
(take-nth (max 1
(long (/ (count rows)
max-sample-rows)))
rows))) |
(defn- upload-type->col-specs [driver col->upload-type] (update-vals col->upload-type (partial driver/upload-type->database-type driver))) | |
The database being used for uploads (as per the | (defn current-database [] (t2/select-one Database :id (public-settings/uploads-database-id))) |
Returns a string that can be used as a table identifier in SQL, including a schema if provided. | (mu/defn ^:private table-identifier
[{:keys [schema name] :as _table}
:- [:map
[:schema {:optional true} [:maybe :string]]
[:name :string]]]
(if (str/blank? schema)
name
(str schema "." name))) |
Returns a lazy seq of parsed rows, given a sequence of upload types for each column. Replaces empty strings with nil. | (defn- parse-rows
[col-upload-types rows]
(let [settings (upload-parsing/get-settings)
parsers (map #(upload-parsing/upload-type->parser % settings) col-upload-types)]
(for [row rows]
(for [[value parser] (map-with-nils vector row parsers)]
(when-not (str/blank? value)
(parser value)))))) |
Removes the elements at the given indices from the collection. Indices is a set. | (defn- remove-indices
[indices coll]
(keep-indexed (fn [idx item]
(when-not (contains? indices idx)
item))
coll)) |
Returns a lazy seq of the indices where the predicate is true. | (defn- indices-where
[pred coll]
(keep-indexed (fn [idx item]
(when (pred item)
idx))
coll)) |
Returns the indices of columns that have the same normalized name as [[auto-pk-column-name]] | (defn- auto-pk-column-indices [header] (set (indices-where #(= auto-pk-column-name (normalize-column-name %)) header))) |
(defn- without-auto-pk-columns
[header-and-rows]
(let [header (first header-and-rows)
auto-pk-indices (auto-pk-column-indices header)]
(cond->> header-and-rows
auto-pk-indices
(map (partial remove-indices auto-pk-indices))))) | |
Loads a table from a CSV file. If the table already exists, it will throw an error. Returns the file size, number of rows, and number of columns. | (defn- load-from-csv!
[driver db-id table-name ^File csv-file]
(with-open [reader (bom/bom-reader csv-file)]
(let [[header & rows] (without-auto-pk-columns (csv/read-csv reader))
{:keys [extant-columns generated-columns]} (detect-schema header (sample-rows rows))
cols->upload-type (merge generated-columns extant-columns)
col-to-create->col-spec (upload-type->col-specs driver cols->upload-type)
csv-col-names (keys extant-columns)
col-upload-types (vals extant-columns)
parsed-rows (vec (parse-rows col-upload-types rows))]
(driver/create-table! driver db-id table-name col-to-create->col-spec)
(try
(driver/insert-into! driver db-id table-name csv-col-names parsed-rows)
{:num-rows (count rows)
:num-columns (count extant-columns)
:generated-columns (count generated-columns)
:size-mb (/ (.length csv-file)
1048576.0)}
(catch Throwable e
(driver/drop-table! driver db-id table-name)
(throw (ex-info (ex-message e) {:status-code 400}))))))) |
+------------------+ | Create upload +------------------+ | |
For testing purposes, often we'd like to sync synchronously so that we can test the results immediately and avoid race conditions. | (def ^:dynamic *sync-synchronously?* false) |
(defn- scan-and-sync-table!
[database table]
(sync-fields/sync-fields-for-table! database table)
(if *sync-synchronously?*
(sync/sync-table! table)
(future
(sync/sync-table! table)))) | |
Returns an ExceptionInfo object if the user cannot upload to the given database for the subset of reasons common to all uploads entry points. Returns nil otherwise. | (defn- can-use-uploads-error
[db]
(let [driver (driver.u/database->driver db)]
(cond
(not (public-settings/uploads-enabled))
(ex-info (tru "Uploads are not enabled.")
{:status-code 422})
(premium-features/sandboxed-user?)
(ex-info (tru "Uploads are not permitted for sandboxed users.")
{:status-code 403})
(not (driver/database-supports? driver :uploads nil))
(ex-info (tru "Uploads are not supported on {0} databases." (str/capitalize (name driver)))
{:status-code 422})))) |
Returns an ExceptionInfo object if the user cannot upload to the given database and schema. Returns nil otherwise. | (defn- can-create-upload-error
[db schema-name]
(or (can-use-uploads-error db)
(cond
(and (str/blank? schema-name)
(driver/database-supports? (driver.u/database->driver db) :schemas db))
(ex-info (tru "A schema has not been set.")
{:status-code 422})
(not (perms/set-has-full-permissions? @api/*current-user-permissions-set*
(perms/data-perms-path (u/the-id db) schema-name)))
(ex-info (tru "You don''t have permissions to do that.")
{:status-code 403})
(and (some? schema-name)
(not (driver.s/include-schema? db schema-name)))
(ex-info (tru "The schema {0} is not syncable." schema-name)
{:status-code 422})))) |
Throws an error if the user cannot upload to the given database and schema. | (defn- check-can-create-upload
[db schema-name]
(when-let [error (can-create-upload-error db schema-name)]
(throw error))) |
Returns true if the user can upload to the given database and schema, and false otherwise. | (defn can-create-upload? [db schema-name] (nil? (can-create-upload-error db schema-name))) |
+----------------------------------------- | public interface for creating CSV table +----------------------------------------- | |
Main entry point for CSV uploading. What it does: - throws an error if the user cannot upload to the given database and schema (see [[can-create-upload-error]] for reasons) - throws an error if the user has write permissions to the given collection - detects the schema of the CSV file - inserts the data into a new table with a unique name, along with an extra auto-generated primary key column - syncs and scans the table - creates a model which wraps the table Requires that current-user dynamic vars in [[metabase.api.common]] are bound as if by API middleware (this is needed for QP permissions checks). Returns the newly created model. May throw validation, permimissions, or DB errors. Args:
- | (mu/defn create-csv-upload!
[{:keys [collection-id filename ^File file db-id schema-name table-prefix]}
:- [:map
[:collection-id [:maybe ms/PositiveInt]]
[:filename :string]
[:file (ms/InstanceOfClass File)]
[:db-id ms/PositiveInt]
[:schema-name {:optional true} [:maybe :string]]
[:table-prefix {:optional true} [:maybe :string]]]]
(let [database (or (t2/select-one Database :id db-id)
(throw (ex-info (tru "The uploads database does not exist.")
{:status-code 422})))]
(check-can-create-upload database schema-name)
(collection/check-write-perms-for-collection collection-id)
(try
(let [start-time (System/currentTimeMillis)
driver (driver.u/database->driver database)
filename-prefix (or (second (re-matches #"(.*)\.csv$" filename))
filename)
table-name (->> (str table-prefix filename-prefix)
(unique-table-name driver)
(u/lower-case-en))
schema+table-name (table-identifier {:schema schema-name :name table-name})
stats (load-from-csv! driver (:id database) schema+table-name file)
;; Sync immediately to create the Table and its Fields; the scan is settings-dependent and can be async
table (sync-tables/create-or-reactivate-table! database {:name table-name :schema (not-empty schema-name)})
_set_is_upload (t2/update! :model/Table (:id table) {:is_upload true})
_sync (scan-and-sync-table! database table)
;; Set the display_name of the auto-generated primary key column to the same as its name, so that if users
;; download results from the table as a CSV and reupload, we'll recognize it as the same column
auto-pk-field (table-id->auto-pk-column (:id table))
_ (t2/update! :model/Field (:id auto-pk-field) {:display_name (:name auto-pk-field)})
card (card/create-card!
{:collection_id collection-id
:dataset true
:database_id (:id database)
:dataset_query {:database (:id database)
:query {:source-table (:id table)}
:type :query}
:display :table
:name (humanization/name->human-readable-name filename-prefix)
:visualization_settings {}}
@api/*current-user*)
upload-seconds (/ (- (System/currentTimeMillis) start-time)
1000.0)]
(snowplow/track-event! ::snowplow/csv-upload-successful
api/*current-user-id*
(merge
{:model-id (:id card)
:upload-seconds upload-seconds}
stats))
card)
(catch Throwable e
(let [fail-stats (with-open [reader (bom/bom-reader file)]
(let [rows (csv/read-csv reader)]
{:size-mb (/ (.length file) 1048576.0)
:num-columns (count (first rows))
:num-rows (count (rest rows))}))]
(snowplow/track-event! ::snowplow/csv-upload-failed api/*current-user-id* fail-stats))
(throw e))))) |
+----------------------------- | appending to uploaded table +----------------------------- | |
Returns the most specific upload type for the given base type. | (defn- base-type->upload-type
[base-type]
(condp #(isa? %2 %1) base-type
:type/Float ::float
:type/BigInteger ::int
:type/Integer ::int
:type/Boolean ::boolean
:type/DateTimeWithTZ ::offset-datetime
:type/DateTime ::datetime
:type/Date ::date
:type/Text ::text)) |
Throws an exception if: - the CSV file contains duplicate column names - the schema of the CSV file does not match the schema of the table | (defn- check-schema
[fields-by-normed-name header]
;; Assumes table-cols are unique when normalized
(let [normalized-field-names (keys fields-by-normed-name)
normalized-header (map normalize-column-name header)
[extra missing _both] (data/diff (set normalized-header) (set normalized-field-names))]
;; check for duplicates
(when (some #(< 1 %) (vals (frequencies normalized-header)))
(throw (ex-info (tru "The CSV file contains duplicate column names.")
{:status-code 422})))
(when (or extra missing)
(let [format-columns (fn [cols]
(str/join ", " (map #(str "\"" % "\"") cols)))
error-message (cond
(and extra missing)
(tru "The CSV file contains extra columns that are not in the table: {0}. The CSV file is missing columns that are in the table: {1}."
(format-columns extra) (format-columns missing))
extra
(tru "The CSV file contains extra columns that are not in the table: {0}."
(format-columns extra))
missing
(tru "The CSV file is missing columns that are in the table: {0}."
(format-columns missing)))]
(throw (ex-info error-message {:status-code 422})))))) |
(defn- append-csv!*
[database table file]
(with-open [reader (bom/bom-reader file)]
(let [[header & rows] (without-auto-pk-columns (csv/read-csv reader))
driver (driver.u/database->driver database)
normed-name->field (m/index-by (comp normalize-column-name :name)
(t2/select :model/Field :table_id (:id table) :active true))
normed-header (map normalize-column-name header)
create-auto-pk? (not (contains? normed-name->field auto-pk-column-name))
_ (check-schema (dissoc normed-name->field auto-pk-column-name) header)
col-upload-types (map (comp base-type->upload-type :base_type normed-name->field) normed-header)
parsed-rows (parse-rows col-upload-types rows)]
(try
(driver/insert-into! driver (:id database) (table-identifier table) normed-header parsed-rows)
(catch Throwable e
(throw (ex-info (ex-message e) {:status-code 422}))))
(when create-auto-pk?
(driver/add-columns! driver
(:id database)
(table-identifier table)
{(keyword auto-pk-column-name) (driver/upload-type->database-type driver ::auto-incrementing-int-pk)}))
(scan-and-sync-table! database table)
(when create-auto-pk?
(let [auto-pk-field (table-id->auto-pk-column (:id table))]
(t2/update! :model/Field (:id auto-pk-field) {:display_name (:name auto-pk-field)})))
{:row-count (count parsed-rows)}))) | |
Returns an ExceptionInfo object if the user cannot upload to the given database and schema. Returns nil otherwise. | (defn- can-append-error
[db table]
(or (can-use-uploads-error db)
(cond
(not (:is_upload table))
(ex-info (tru "The table must be an uploaded table.")
{:status-code 422})
(not (mi/can-read? table))
(ex-info (tru "You don''t have permissions to do that.")
{:status-code 403})))) |
Throws an error if the user cannot upload to the given database and schema. | (defn- check-can-append
[db table]
(when-let [error (can-append-error db table)]
(throw error))) |
Returns true if the user can upload to the given database and table, and false otherwise. This will be used in merge 2 of milestone 1 to populate a property on the table for the FE. | (defn can-upload-to-table? [db table] (nil? (can-append-error db table))) |
+-------------------------------------------------- | public interface for appending to uploaded table +-------------------------------------------------- | |
Main entry point for appending to uploaded tables with a CSV file. | (mu/defn append-csv!
[{:keys [^File file table-id]}
:- [:map
[:table-id ms/PositiveInt]
[:file (ms/InstanceOfClass File)]]]
(let [table (api/check-404 (t2/select-one :model/Table :id table-id))
database (table/database table)]
(check-can-append database table)
(append-csv!* database table file))) |
(ns metabase.upload.parsing (:require [clojure.string :as str] [java-time.api :as t] [metabase.public-settings :as public-settings] [metabase.util.i18n :refer [tru]]) (:import (java.time LocalDate) (java.time.format DateTimeFormatter DateTimeFormatterBuilder ResolverStyle) (java.text NumberFormat) (java.util Locale))) | |
(set! *warn-on-reflection* true) | |
Supported currency signs | (def currency-regex #"[$€£¥₹₪₩₿¢\s]") |
Settings that determine how the CSV is parsed. Includes:
- number-separators: Decimal delimiter defaults to | (defn get-settings
[]
{:number-separators (get-in (public-settings/custom-formatting) [:type/Number :number_separators] ".,")}) |
Parses a boolean value (true/t/yes/y/1 and false/f/no/n/0). Case-insensitive. | (defn- parse-bool
[s]
(cond
(re-matches #"(?i)true|t|yes|y|1" s) true
(re-matches #"(?i)false|f|no|n|0" s) false
:else (throw (IllegalArgumentException.
(tru "''{0}'' is not a recognizable boolean" s))))) |
patterns used to generate the local date formatter. Excludes ISOLOCALDATE (uuuu-MM-dd) because there's already a built-in DateTimeFormatter for that: [[DateTimeFormatter/ISOLOCALDATE]] | (def local-date-patterns ;; uuuu is like yyyy but is required for strict parsing and also supports negative years for BC dates ;; see https://stackoverflow.com/questions/41103603/issue-with-datetimeparseexception-when-using-strict-resolver-style ;; uuuu is faster than using yyyy and setting a default era ["MMM dd uuuu" ; Jan 30 2000 "MMM dd, uuuu" ; Jan 30, 2000 "dd MMM uuuu" ; 30 Jan 2000 "dd MMM, uuuu" ; 30 Jan, 2000 "MMMM d uuuu" ; January 30 2000 "MMMM d, uuuu" ; January 30, 2000 "d MMMM uuuu" ; 30 January 2000 "d MMMM, uuuu" ; 30 January, 2000 "EEEE, MMMM d uuuu" ; Sunday, January 30 2000 "EEEE, MMMM d, uuuu" ; Sunday, January 30, 2000 ]) |
DateTimeFormatter that runs through a set of patterns to parse a variety of local date formats. | (def local-date-formatter
(let [builder (-> (DateTimeFormatterBuilder.)
(.parseCaseInsensitive))]
(doseq [pattern local-date-patterns]
(.appendOptional builder (DateTimeFormatter/ofPattern pattern)))
(-> builder
(.appendOptional DateTimeFormatter/ISO_LOCAL_DATE)
(.toFormatter)
(.withResolverStyle ResolverStyle/STRICT)))) |
Parses a local date string. Supported formats: - yyyy-MM-dd - MMM dd yyyy - MMM dd, yyyy - dd MMM yyyy - dd MMM, yyyy - MMMM d yyyy - MMMM d, yyyy - d MMMM yyyy - d MMMM, yyyy | (defn parse-local-date
[s]
(try
(LocalDate/parse s local-date-formatter)
(catch Exception _
(throw (IllegalArgumentException.
(tru "''{0}'' is not a recognizable date" s)))))) |
Parses a string representing a local datetime into a LocalDateTime. Supported formats: - yyyy-MM-dd'T'HH:mm - yyyy-MM-dd'T'HH:mm:ss - yyyy-MM-dd'T'HH:mm:ss.SSS (and any other number of S's) - the above formats, with a space instead of a 'T' Parsing is case-insensitive. | (defn parse-local-datetime [s] (-> s (str/replace \space \T) t/local-date-time)) |
Parses a string | (defn- parse-as-datetime
[s]
(try
(t/local-date-time (parse-local-date s) (t/local-time "00:00:00"))
(catch Exception _
(try
(parse-local-datetime s)
(catch Exception _
(throw (IllegalArgumentException.
(tru "''{0}'' is not a recognizable datetime" s)))))))) |
Parses a string representing an offset datetime into an OffsetDateTime. The format consists of: 1) The a date and time, with the formats: - yyyy-MM-dd'T'HH:mm - yyyy-MM-dd'T'HH:mm:ss - yyyy-MM-dd'T'HH:mm:ss.SSS (and any other number of S's) - the above formats, with a space instead of a 'T' 2) An offset, with the formats: - Z (for UTC) - +HH or -HH - +HH:mm or -HH:mm - +HH:mm:ss or -HH:mm:ss Parsing is case-insensitive. | (defn parse-offset-datetime
[s]
(try
(-> s (str/replace \space \T) t/offset-date-time)
(catch Exception _
(throw (IllegalArgumentException. (tru "''{0}'' is not a recognizable zoned datetime" s)))))) |
Remove any recognized currency signs from the string (c.f. [[currency-regex]]). | (defn- remove-currency-signs [s] (str/replace s currency-regex "")) |
(let [us (NumberFormat/getInstance (Locale. "en" "US"))
de (NumberFormat/getInstance (Locale. "de" "DE"))
fr (NumberFormat/getInstance (Locale. "fr" "FR"))
ch (NumberFormat/getInstance (Locale. "de" "CH"))]
(defn- parse-plain-number [number-separators s]
(let [has-parens? (re-matches #"\(.*\)" s)
deparenthesized-s (str/replace s #"[()]" )
parsed-number (case number-separators
("." ".,") (. us parse deparenthesized-s)
",." (. de parse deparenthesized-s)
", " (. fr parse (str/replace deparenthesized-s \space \u00A0)) ; \u00A0 is a non-breaking space
".’" (. ch parse deparenthesized-s))]
(if has-parens?
(- parsed-number)
parsed-number)))) | |
Parse an integer or float | (defn- parse-number
[number-separators s]
(try
(->> s
(str/trim)
(remove-currency-signs)
(parse-plain-number number-separators))
(catch Exception _
(throw (IllegalArgumentException. (tru "''{0}'' is not a recognizable number" s)))))) |
Parses a string representing a number as a java.math.BigInteger, rounding down if necessary. | (defn- parse-as-biginteger [number-separators s] (biginteger (parse-number number-separators s))) |
Returns a function for the given | (defmulti upload-type->parser
{:arglists '([upload-type settings])}
(fn [upload-type _]
upload-type)) |
(defmethod upload-type->parser :metabase.upload/varchar-255 [_ _] identity) | |
(defmethod upload-type->parser :metabase.upload/text [_ _] identity) | |
(defmethod upload-type->parser :metabase.upload/int
[_ {:keys [number-separators]}]
(partial parse-as-biginteger number-separators)) | |
(defmethod upload-type->parser :metabase.upload/float
[_ {:keys [number-separators]}]
(partial parse-number number-separators)) | |
(defmethod upload-type->parser :metabase.upload/auto-incrementing-int-pk
[_ {:keys [number-separators]}]
(partial parse-as-biginteger number-separators)) | |
(defmethod upload-type->parser :metabase.upload/boolean [_ _] (comp parse-bool str/trim)) | |
(defmethod upload-type->parser :metabase.upload/date [_ _] (comp parse-local-date str/trim)) | |
(defmethod upload-type->parser :metabase.upload/datetime [_ _] (comp parse-as-datetime str/trim)) | |
(defmethod upload-type->parser :metabase.upload/offset-datetime [_ _] (comp parse-offset-datetime str/trim)) | |
(ns metabase.util.compress (:require [clojure.java.io :as io]) (:import (java.io File) (org.apache.commons.compress.archivers.tar TarArchiveEntry TarArchiveInputStream TarArchiveOutputStream) (org.apache.commons.compress.compressors.gzip GzipCompressorInputStream GzipCompressorOutputStream GzipParameters))) | |
(set! *warn-on-reflection* true) | |
Tar file entries as a lazy sequence. | (defn entries
[^TarArchiveInputStream tar]
(lazy-seq
(when-let [entry (.getNextEntry tar)]
(cons entry (entries tar))))) |
Compress directory | (defn tgz
[^File src ^File dst]
(when-not (.exists src)
(throw (ex-info (format "Path is not readable or does not exist: %s" src)
{:path src})))
(let [prefix (.getPath (.getParentFile src))]
(with-open [tar (-> (io/output-stream dst)
(GzipCompressorOutputStream. (doto (GzipParameters.)
(.setModificationTime (System/currentTimeMillis))))
(TarArchiveOutputStream. 512 "UTF-8"))]
(.setLongFileMode tar TarArchiveOutputStream/LONGFILE_POSIX)
(doseq [^File f (file-seq src)
:let [path-in-tar (subs (.getPath f) (count prefix))
entry (TarArchiveEntry. f path-in-tar)]]
(.putArchiveEntry tar entry)
(when (.isFile f)
(with-open [s (io/input-stream f)]
(io/copy s tar)))
(.closeArchiveEntry tar)))
dst)) |
Uncompress tar+gzip file | (defn untgz
[^File archive ^File dst]
(with-open [tar (-> (io/input-stream archive)
(GzipCompressorInputStream.)
(TarArchiveInputStream.))]
(let [[dir :as tar-entries] (entries tar)]
(doseq [^TarArchiveEntry e tar-entries]
(let [f (io/file dst (.getName e))]
(if (.isFile e)
(io/copy tar f)
(.mkdirs f))))
(when dir
(.getName ^TarArchiveEntry dir))))) |
(ns metabase.util.connection
(:require [metabase.util :as u]
[toucan2.core :as t2])
(:import
(java.sql Connection))) | |
(set! *warn-on-reflection* true) | |
Returns a map of all column names to their respective type names for the given | (defn app-db-column-types
[app-db table-name']
(let [table-name (cond-> table-name'
(= (:db-type app-db) :h2) u/upper-case-en)]
(t2/with-connection [^Connection conn]
(with-open [rset (.getColumns (.getMetaData conn) nil nil table-name nil)]
(into {}
(iteration
(fn [_]
(when (.next rset)
[(.getString rset "COLUMN_NAME") (.getString rset "TYPE_NAME")])))))))) |
Utility functions for converting frontend schedule dictionaries to cron strings and vice versa. See http://www.quartz-scheduler.org/documentation/quartz-2.x/tutorials/crontrigger.html#format for details on cron format. | (ns metabase.util.cron (:require [clojure.string :as str] [metabase.util.i18n :as i18n] [metabase.util.malli :as mu] [metabase.util.malli.registry :as mr] [metabase.util.malli.schema :as ms]) (:import (net.redhogs.cronparser CronExpressionDescriptor) (org.quartz CronExpression))) |
(set! *warn-on-reflection* true) | |
(mr/def ::CronScheduleString
(mu/with-api-error-message
[:and
ms/NonBlankString
[:fn
{:error/message "Invalid cron schedule string."}
(fn [^String s]
(try
(CronExpression/validateExpression s)
true
(catch Throwable _
false)))]]
(i18n/deferred-tru "value must be a valid Quartz cron schedule string."))) | |
Malli Schema for a valid cron schedule string. | (def CronScheduleString [:ref ::CronScheduleString]) |
(mr/def ::CronHour
[:int {:min 0, :max 23}]) | |
(mr/def ::CronMinute
[:int {:min 0, :max 59}]) | |
(mr/def ::ScheduleMap
(mu/with-api-error-message
[:map
{:error/message "Expanded schedule map"}
[:schedule_type [:enum "hourly" "daily" "weekly" "monthly"]]
[:schedule_day {:optional true} [:maybe [:enum "sun" "mon" "tue" "wed" "thu" "fri" "sat"]]]
[:schedule_frame {:optional true} [:maybe [:enum "first" "mid" "last"]]]
[:schedule_hour {:optional true} [:maybe ::CronHour]]
[:schedule_minute {:optional true} [:maybe ::CronMinute]]]
(i18n/deferred-tru "value must be a valid schedule map. See schema in metabase.util.cron for details."))) | |
Schema for a frontend-parsable schedule map. Used for Pulses and DB scheduling. | (def ScheduleMap [:ref ::ScheduleMap]) |
+----------------------------------------------------------------------------------------------------------------+ | SCHEDULE MAP -> CRON STRING | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn ^:private cron-string :- CronScheduleString
"Build a cron string from key-value pair parts."
[{:keys [seconds minutes hours day-of-month month day-of-week year]}]
(str/join " " [(or seconds "0")
(or minutes "0")
(or hours "*")
(or day-of-month "*")
(or month "*")
(or day-of-week "?")
(or year "*")])) | |
(def ^:private day-of-week->cron
{"sun" 1
"mon" 2
"tue" 3
"wed" 4
"thu" 5
"fri" 6
"sat" 7}) | |
(defn- frame->cron [frame day-of-week]
(if day-of-week
;; specific days of week like Mon or Fri
(assoc {:day-of-month "?"}
:day-of-week (case frame
"first" (str (day-of-week->cron day-of-week) "#1")
"last" (str (day-of-week->cron day-of-week) "L")))
;; specific CALENDAR DAYS like 1st or 15th
(assoc {:day-of-week "?"}
:day-of-month (case frame
"first" "1"
"mid" "15"
"last" "L")))) | |
(mu/defn schedule-map->cron-string :- CronScheduleString
"Convert the frontend schedule map into a cron string."
[{day-of-week :schedule_day, hour :schedule_hour, minute :schedule_minute,
frame :schedule_frame, schedule-type :schedule_type} :- ScheduleMap]
(cron-string (case (keyword schedule-type)
:hourly {:minutes minute}
:daily {:hours (or hour 0)}
:weekly {:hours hour
:day-of-week (day-of-week->cron day-of-week)
:day-of-month "?"}
:monthly (assoc (frame->cron frame day-of-week)
:hours hour)))) | |
+----------------------------------------------------------------------------------------------------------------+ | CRON STRING -> SCHEDULE MAP | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- cron->day-of-week [day-of-week]
(when-let [[_ day-of-week] (re-matches #"(^\d).*$" day-of-week)]
(case day-of-week
"1" "sun"
"2" "mon"
"3" "tue"
"4" "wed"
"5" "thu"
"6" "fri"
"7" "sat"))) | |
(defn- cron-day-of-week+day-of-month->frame [day-of-week day-of-month]
(cond
(re-matches #"^\d#1$" day-of-week) "first"
(re-matches #"^\dL$" day-of-week) "last"
(= day-of-month "1") "first"
(= day-of-month "15") "mid"
(= day-of-month "L") "last"
:else nil)) | |
(defn- cron->digit [digit]
(when (and digit
(not= digit "*"))
(Integer/parseInt digit))) | |
(defn- cron->schedule-type [hours day-of-month day-of-week]
(cond
(and day-of-month
(not= day-of-month "*")
(or (= day-of-week "?")
(re-matches #"^\d#1$" day-of-week)
(re-matches #"^\dL$" day-of-week))) "monthly"
(and day-of-week
(not= day-of-week "?")) "weekly"
(and hours
(not= hours "*")) "daily"
:else "hourly")) | |
(mu/defn ^{:style/indent 0} cron-string->schedule-map :- ScheduleMap
"Convert a normal `cron-string` into the expanded ScheduleMap format used by the frontend."
[cron-string :- CronScheduleString]
(let [[_ mins hours day-of-month _ day-of-week _] (str/split cron-string #"\s+")]
{:schedule_minute (cron->digit mins)
:schedule_day (cron->day-of-week day-of-week)
:schedule_frame (cron-day-of-week+day-of-month->frame day-of-week day-of-month)
:schedule_hour (cron->digit hours)
:schedule_type (cron->schedule-type hours day-of-month day-of-week)})) | |
(mu/defn describe-cron-string :- ms/NonBlankString "Return a human-readable description of a cron expression, localized for the current User." [^String cron-string :- CronScheduleString] (CronExpressionDescriptor/getDescription cron-string (i18n/user-locale))) | |
Replacement for | (ns metabase.util.date-2 (:refer-clojure :exclude [format range]) (:require [clojure.string :as str] [java-time.api :as t] [java-time.core :as t.core] [metabase.util.date-2.common :as u.date.common] [metabase.util.date-2.parse :as u.date.parse] [metabase.util.i18n :as i18n :refer [tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [potemkin.types :as p.types]) (:import (java.time DayOfWeek Duration Instant LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime Period ZonedDateTime) (java.time.format DateTimeFormatter DateTimeFormatterBuilder FormatStyle TextStyle) (java.time.temporal Temporal TemporalAdjuster WeekFields) (org.threeten.extra PeriodDuration))) |
(set! *warn-on-reflection* true) | |
(def ^:private TemporalInstance
[:fn
{:error/message "Instance of a java.time.temporal.Temporal"}
(partial instance? Temporal)]) | |
Converts a temporal type without timezone info to one with zone info (i.e., a | (defn- add-zone-to-local
[t timezone-id]
(condp instance? t
LocalDateTime (t/zoned-date-time t (t/zone-id timezone-id))
LocalDate (t/zoned-date-time t (t/local-time 0) (t/zone-id timezone-id))
;; don't attempt to convert local times to offset times because we have no idea what the offset
;; actually should be, since we don't know the date. Since it's not an exact instant in time we're
;; not using it to make ranges in MBQL filter clauses anyway
;;
;; TIMEZONE FIXME - not sure we even want to be adding zone-id info for the timestamps above either
#_LocalTime #_ (t/offset-time t (t/zone-id timezone-id))
t)) |
With one arg, parse a temporal literal into a corresponding | (defn parse
([s]
(u.date.parse/parse s))
([s default-timezone-id]
(let [result (parse s)]
(if-not default-timezone-id
result
(let [result-with-timezone (add-zone-to-local result default-timezone-id)]
(when-not (= result result-with-timezone)
(log/tracef "Applying default timezone %s to temporal literal without timezone '%s' -> %s"
default-timezone-id s (pr-str result-with-timezone)))
result-with-timezone))))) |
(defn- temporal->iso-8601-formatter [t]
(condp instance? t
Instant :iso-offset-date-time
LocalDate :iso-local-date
LocalTime :iso-local-time
LocalDateTime :iso-local-date-time
OffsetTime :iso-offset-time
OffsetDateTime :iso-offset-date-time
ZonedDateTime :iso-offset-date-time)) | |
Format temporal value
| (defn format
(^String [t]
(when t
(format (temporal->iso-8601-formatter t) t)))
(^String [formatter t]
(format formatter t nil))
(^String [formatter t locale]
(cond
(t/instant? t)
(recur formatter (t/zoned-date-time t (t/zone-id "UTC")) locale)
locale
(recur (.withLocale (t/formatter formatter) (i18n/locale locale)) t nil)
:else
(t/format formatter t)))) |
Format temporal value | (defn format-rfc3339
[t]
(cond
(instance? Instant t)
(recur (t/zoned-date-time t (t/zone-id "UTC")))
;; the rfc3339 format requires a timezone component so convert any local datetime/date to zoned
(instance? LocalDateTime t)
(recur (t/zoned-date-time t (t/zone-id)))
(instance? LocalDate t)
(recur (t/zoned-date-time t (t/local-time 0) (t/zone-id)))
:else
(t/format "yyyy-MM-dd'T'hh:mm:ss.SSXXX" t))) |
Format a temporal value | (defn format-sql
^String [t]
;; replace the `T` with a space. Easy!
(str/replace-first (format t) #"(\d{2})T(\d{2})" "$1 $2")) |
(def ^:private ^{:arglists '(^java.time.format.DateTimeFormatter [klass])} class->human-readable-formatter
{LocalDate (DateTimeFormatter/ofLocalizedDate FormatStyle/LONG)
LocalTime (DateTimeFormatter/ofLocalizedTime FormatStyle/MEDIUM)
LocalDateTime (let [builder (doto (DateTimeFormatterBuilder.)
(.appendLocalized FormatStyle/LONG FormatStyle/MEDIUM))]
(.toFormatter builder))
OffsetTime (let [builder (doto (DateTimeFormatterBuilder.)
(.append (DateTimeFormatter/ofLocalizedTime FormatStyle/MEDIUM))
(.appendLiteral " (")
(.appendLocalizedOffset TextStyle/FULL)
(.appendLiteral ")"))]
(.toFormatter builder))
OffsetDateTime (let [builder (doto (DateTimeFormatterBuilder.)
(.appendLocalized FormatStyle/LONG FormatStyle/MEDIUM)
(.appendLiteral " (")
(.appendLocalizedOffset TextStyle/FULL)
(.appendLiteral ")"))]
(.toFormatter builder))
ZonedDateTime (let [builder (doto (DateTimeFormatterBuilder.)
(.appendLocalized FormatStyle/LONG FormatStyle/MEDIUM)
(.appendLiteral " (")
(.appendZoneText TextStyle/FULL)
(.appendLiteral ")"))]
(.toFormatter builder))}) | |
Format a temporal value (format-human-readable #t "2021-04-02T14:42:09.524392-07:00[US/Pacific]" "es-MX") ;; -> "2 de abril de 2021 02:42:09 PM PDT" | (defn format-human-readable
([t]
(format-human-readable t (i18n/user-locale)))
([t locale]
(when t
(if-let [formatter (some (fn [[klass formatter]]
(when (instance? klass t)
formatter))
class->human-readable-formatter)]
(format formatter t locale)
(throw (ex-info (tru "Don''t know how to format a {0} as a human-readable date/time"
(some-> t class .getCanonicalName))
{:t t})))))) |
A list of units that can be added to a temporal value. | (def add-units
#{:millisecond :second :minute :hour :day :week :month :quarter :year}) |
(mu/defn add :- TemporalInstance
"Return a temporal value relative to temporal value `t` by adding (or subtracting) a number of units. Returned value
will be of same class as `t`.
(add (t/zoned-date-time \"2019-11-05T15:44-08:00[US/Pacific]\") :month 2)
->
(t/zoned-date-time \"2020-01-05T15:44-08:00[US/Pacific]\")"
([unit amount]
(add (t/zoned-date-time) unit amount))
([t :- TemporalInstance
unit :- (into [:enum] add-units)
amount :- [:maybe :int]]
(if (zero? amount)
t
(t/plus t (case unit
:millisecond (t/millis amount)
:second (t/seconds amount)
:minute (t/minutes amount)
:hour (t/hours amount)
:day (t/days amount)
:week (t/days (* amount 7))
:month (t/months amount)
:quarter (t/months (* amount 3))
:year (t/years amount)))))) | |
Units which return a (numerical, periodic) component of a date TIMEZONE FIXME - we should add | (def extract-units
#{:second-of-minute
:minute-of-hour
:hour-of-day
:day-of-week
:day-of-month
:day-of-year
:week-of-year
:month-of-year
:quarter-of-year
;; TODO - in this namespace `:year` is something you can both extract and truncate to. In MBQL `:year` is a truncation
;; operation. Maybe we should rename this unit to clear up the potential confusion (?)
:year}) |
(defn- start-of-week [] (keyword ((requiring-resolve 'metabase.public-settings/start-of-week)))) | |
(def ^:private ^{:arglists '(^java.time.DayOfWeek [k])} day-of-week*
(let [m (u.date.common/static-instances DayOfWeek)]
(fn [k]
(or (get m k)
(throw (ex-info (tru "Invalid day of week: {0}" (pr-str k))
{:k k, :allowed (keys m)})))))) | |
Create a new instance of a (week-fields :monday) ; -> #object[java.time.temporal.WeekFields "WeekFields[MONDAY,1]"] | (defn- week-fields (^WeekFields [first-day-of-week] ;; TODO -- ISO weeks only consider a week to be in a year if it has 4+ days in that year... `:week-of-year` ;; extraction is liable to be off for people who expect that definition of "week of year". We should probably make ;; this a Setting. See #15039 for more information (week-fields first-day-of-week 1)) (^WeekFields [first-day-of-week ^Integer minimum-number-of-days-in-first-week] (WeekFields/of (day-of-week* first-day-of-week) minimum-number-of-days-in-first-week))) |
(mu/defn extract :- :int
"Extract a field such as `:minute-of-hour` from a temporal value `t`.
(extract (t/zoned-date-time \"2019-11-05T15:44-08:00[US/Pacific]\") :day-of-month)
;; -> 5
Values are returned as numbers (currently, always and integers, but this may change if we add support for
`:fraction-of-second` in the future.)"
([unit]
(extract (t/zoned-date-time) unit))
([t :- TemporalInstance
unit :- (into [:enum] extract-units)]
(t/as t (case unit
:second-of-minute :second-of-minute
:minute-of-hour :minute-of-hour
:hour-of-day :hour-of-day
:day-of-week (.dayOfWeek (week-fields (start-of-week)))
:day-of-month :day-of-month
:day-of-year :day-of-year
:week-of-year (.weekOfYear (week-fields (start-of-week)))
:month-of-year :month-of-year
:quarter-of-year :quarter-of-year
:year :year)))) | |
Get the custom ;; adjust 2019-12-10T17:26 to the second week of the year (t/adjust #t "2019-12-10T17:26" (u.date/adjuster :week-of-year 2)) ;; -> #t "2019-01-06T17:26" | (defmulti ^TemporalAdjuster adjuster
{:arglists '([k & args])}
(fn [k & _] (keyword k))) |
(defmethod adjuster :default
[k]
(throw (Exception. (tru "No temporal adjuster named {0}" k)))) | |
(defmethod adjuster :first-day-of-week
[_]
(reify TemporalAdjuster
(adjustInto [_ t]
(t/adjust t :previous-or-same-day-of-week (start-of-week))))) | |
(defmethod adjuster :first-day-of-quarter
[_]
(reify TemporalAdjuster
(adjustInto [_ t]
(.with t (.atDay (t/year-quarter t) 1))))) | |
(defmethod adjuster :first-week-of-year
[_]
(reify TemporalAdjuster
(adjustInto [_ t]
(-> t
(t/adjust :first-day-of-year)
(t/adjust (adjuster :first-day-of-week)))))) | |
(defmethod adjuster :week-of-year
[_ week-of-year]
(reify TemporalAdjuster
(adjustInto [_ t]
(-> t
(t/adjust (adjuster :first-week-of-year))
(t/plus (t/weeks (dec week-of-year))))))) | |
if you attempt to truncate a | (extend-protocol t.core/Truncatable
LocalDate
(truncate-to [t unit]
(case unit
:millis t
:seconds t
:minutes t
:hours t
:days t))) |
See https://github.com/dm3/clojure.java-time/issues/95. We need to update the | (alter-var-root #'t/truncate-to (constantly t.core/truncate-to)) |
Valid date trucation units | (def truncate-units
#{:millisecond :second :minute :hour :day :week :month :quarter :year}) |
(mu/defn truncate :- TemporalInstance
"Truncate a temporal value `t` to the beginning of `unit`, e.g. `:hour` or `:day`. Not all truncation units are
supported on all subclasses of `Temporal` — for example, you can't truncate a `LocalTime` to `:month`, for obvious
reasons."
([unit]
(truncate (t/zoned-date-time) unit))
([^Temporal t :- TemporalInstance
unit :- (into [:enum] truncate-units)]
(case unit
:default t
:millisecond (t/truncate-to t :millis)
:second (t/truncate-to t :seconds)
:minute (t/truncate-to t :minutes)
:hour (t/truncate-to t :hours)
:day (t/truncate-to t :days)
:week (-> (.with t (adjuster :first-day-of-week)) (t/truncate-to :days))
:month (-> (t/adjust t :first-day-of-month) (t/truncate-to :days))
:quarter (-> (.with t (adjuster :first-day-of-quarter)) (t/truncate-to :days))
:year (-> (t/adjust t :first-day-of-year) (t/truncate-to :days))))) | |
(mu/defn bucket :- [:or number? TemporalInstance]
"Perform a truncation or extraction unit on temporal value `t`. (These two operations are collectively known as
'date bucketing' in Metabase code and MBQL, e.g. for date/time columns in MBQL `:breakout` (SQL `GROUP BY`)).
You can combine this function with `group-by` to do some date/time bucketing in Clojure-land:
(group-by #(bucket % :quarter-of-year) (map t/local-date [\"2019-01-01\" \"2019-01-02\" \"2019-01-04\"]))
;; -> {1 [(t/local-date \"2019-01-01\") (t/local-date \"2019-01-02\")], 2 [(t/local-date \"2019-01-04\")]}"
([unit]
(bucket (t/zoned-date-time) unit))
([t :- TemporalInstance
unit :- (into [:enum] cat [extract-units truncate-units])]
(cond
(= unit :default) t
(extract-units unit) (extract t unit)
(truncate-units unit) (truncate t unit)
:else (throw (Exception. (tru "Invalid unit: {0}" unit)))))) | |
(mu/defn range :- [:map
[:start TemporalInstance]
[:end TemporalInstance]]
"Get a start (by default, inclusive) and end (by default, exclusive) pair of instants for a `unit` span of time
containing `t`. e.g.
(range (t/zoned-date-time \"2019-11-01T15:29:00Z[UTC]\") :week)
->
{:start (t/zoned-date-time \"2019-10-27T00:00Z[UTC]\")
:end (t/zoned-date-time \"2019-11-03T00:00Z[UTC]\")}"
([unit]
(range (t/zoned-date-time) unit))
([t unit]
(range t unit nil))
([t :- TemporalInstance
unit :- (into [:enum] add-units)
{:keys [start end resolution]
:or {start :inclusive
end :exclusive
resolution :millisecond}}]
(let [t (truncate t unit)]
{:start (case start
:inclusive t
:exclusive (add t resolution -1))
:end (case end
:inclusive (add (add t unit 1) resolution -1)
:exclusive (add t unit 1))}))) | |
Generate an range that of instants that when bucketed by ;; Generate range off instants that have the same MONTH as Nov 18th (comparison-range (t/local-date "2019-11-18") :month := {:resolution :day}) ;; -> {:start (t/local-date "2019-11-01"), :end (t/local-date "2019-12-01")} | (defn comparison-range
([unit comparison-type]
(comparison-range (t/zoned-date-time) unit comparison-type))
([t unit comparison-type]
(comparison-range t unit comparison-type nil))
([t unit comparison-type {:keys [start end resolution]
:or {start :inclusive
end :exclusive
resolution :millisecond}
:as options}]
(case comparison-type
:< {:end (case end
:inclusive (add (truncate t unit) resolution -1)
:exclusive (truncate t unit))}
:<= {:end (let [t (add (truncate t unit) unit 1)]
(case end
:inclusive (add t resolution -1)
:exclusive t))}
:> {:start (let [t (add (truncate t unit) unit 1)]
(case start
:inclusive t
:exclusive (add t resolution -1)))}
:>= {:start (let [t (truncate t unit)]
(case start
:inclusive t
:exclusive (add t resolution -1)))}
:= (range t unit options)))) |
Return the Duration between two temporal values Moving the type hints to the arg lists makes clj-kondo happy, but breaks eastwood (and maybe causes reflection warnings) at the call sites. | #_{:clj-kondo/ignore [:non-arg-vec-return-type-hint]}
(defn ^PeriodDuration period-duration
{:arglists '([s] [period] [duration] [period duration] [start end])}
([x]
(when x
(condp instance? x
PeriodDuration x
CharSequence (PeriodDuration/parse x)
Period (PeriodDuration/of ^Period x)
Duration (PeriodDuration/of ^Duration x))))
([x y]
(cond
(and (instance? Period x) (instance? Duration y))
(PeriodDuration/of x y)
(instance? Instant x)
(period-duration (t/offset-date-time x (t/zone-offset 0)) y)
(instance? Instant y)
(period-duration x (t/offset-date-time y (t/zone-offset 0)))
:else
(PeriodDuration/between x y)))) |
With two args: Compare two periods/durations. Returns a negative value if (u.date/compare-period-durations "P1Y" "P11M") ; -> 1 (i.e., 1 year is longer than 11 months) You can combine this with (u.date/compare-period-durations (u.date/period-duration #t "2019-01-01" #t "2019-07-01") "P11M") ; -> -1 Note that this calculation is inexact, since it calclates relative to a fixed point in time, but should be sufficient for most if not all use cases. | (defn compare-period-durations
[d1 d2]
(when (and d1 d2)
(let [t (t/offset-date-time "1970-01-01T00:00Z")]
(compare (.addTo (period-duration d1) t)
(.addTo (period-duration d2) t))))) |
True if period/duration | (defn greater-than-period-duration? [d1 d2] (pos? (compare-period-durations d1 d2))) |
Return a temporal value representing now of the same class as | (defn- now-of-same-class
^Temporal [t]
(when t
(condp instance? t
Instant (t/instant)
LocalDate (t/local-date)
LocalTime (t/local-time)
LocalDateTime (t/local-date-time)
OffsetTime (t/offset-time)
OffsetDateTime (t/offset-date-time)
ZonedDateTime (t/zoned-date-time)))) |
True if temporal value ;; did | (defn older-than? [t duration] (greater-than-period-duration? (period-duration t (now-of-same-class t)) duration)) |
Protocol for converting a temporal value to an equivalent one in a given timezone. | (p.types/defprotocol+ WithTimeZoneSameInstant
(^{:style/indent 0} with-time-zone-same-instant [t ^java.time.ZoneId zone-id]
"Convert a temporal value to an equivalent one in a given timezone. For local temporal values, this simply
converts it to the corresponding offset/zoned type; for offset/zoned types, this applies an appropriate timezone
shift.")) |
(extend-protocol WithTimeZoneSameInstant
;; convert to a OffsetTime with no offset (UTC); the OffsetTime method impl will apply the zone shift.
LocalTime
(with-time-zone-same-instant [t zone-id]
(t/offset-time t (u.date.common/standard-offset zone-id)))
OffsetTime
(with-time-zone-same-instant [t ^java.time.ZoneId zone-id]
(t/with-offset-same-instant t (u.date.common/standard-offset zone-id)))
LocalDate
(with-time-zone-same-instant [t zone-id]
(t/offset-date-time t (t/local-time 0) zone-id))
LocalDate
(with-time-zone-same-instant [t zone-id]
(t/offset-date-time t (t/local-time 0) zone-id))
LocalDateTime
(with-time-zone-same-instant [t zone-id]
(t/offset-date-time t zone-id))
;; instants are always normalized to UTC, so don't make any changes here. If you want to format in a different zone,
;; convert to an OffsetDateTime or ZonedDateTime first.
Instant
(with-time-zone-same-instant [t _]
t)
OffsetDateTime
(with-time-zone-same-instant [t ^java.time.ZoneId zone-id]
;; calculate the zone offset applicable for the date in question
(if (or (= t OffsetDateTime/MAX)
(= t OffsetDateTime/MIN))
t
(let [rules (.getRules zone-id)
offset (.getOffset rules (t/instant t))]
(t/with-offset-same-instant t offset))))
ZonedDateTime
(with-time-zone-same-instant [t zone-id]
(t/with-zone-same-instant t zone-id))) | |
+----------------------------------------------------------------------------------------------------------------+ | Etc | +----------------------------------------------------------------------------------------------------------------+ | |
Mainly for REPL usage. Have various temporal types print as a | (doseq [[klass _f-symb] {Instant 't/instant
LocalDate 't/local-date
LocalDateTime 't/local-date-time
LocalTime 't/local-time
OffsetDateTime 't/offset-date-time
OffsetTime 't/offset-time
ZonedDateTime 't/zoned-date-time}]
(defmethod print-method klass
[t writer]
((get-method print-dup klass) t writer))
(defmethod print-dup klass
[t ^java.io.Writer writer]
(.write writer (clojure.core/format "#t \"%s\"" (str t))))) |
(defmethod print-method PeriodDuration [d writer] ((get-method print-dup PeriodDuration) d writer)) | |
(defmethod print-dup PeriodDuration [d ^java.io.Writer writer] (.write writer (clojure.core/format "(metabase.util.date-2/period-duration %s)" (pr-str (str d))))) | |
(defmethod print-method Period [d writer] (print-method (list 't/period (str d)) writer)) | |
(defmethod print-method Duration [d writer] (print-method (list 't/duration (str d)) writer)) | |
(ns metabase.util.date-2.common (:require [clojure.string :as str] [java-time.api :as t] [metabase.util :as u]) (:import (java.time ZoneId ZoneOffset) (java.time.temporal ChronoField IsoFields TemporalField WeekFields))) | |
(set! *warn-on-reflection* true) | |
TODO - not sure this belongs here, it seems to be a bit more general than just | |
Utility function to get the static members of a class. Returns map of | (defn static-instances
([^Class klass]
(static-instances klass klass))
([^Class klass ^Class target-class]
(into {} (for [^java.lang.reflect.Field f (.getFields klass)
:when (.isAssignableFrom target-class (.getType f))]
[(keyword (u/lower-case-en (str/replace (.getName f) #"_" "-")))
(.get f nil)])))) |
Map of lisp-style-name -> TemporalField for all the various TemporalFields we use in day-to-day parsing and other temporal operations. | (def ^TemporalField temporal-field
(merge
;; honestly I have no idea why there's both IsoFields/WEEK_OF_WEEK_BASED_YEAR and (.weekOfWeekBasedYear
;; WeekFields/ISO)
(into {} (for [[k v] (static-instances IsoFields TemporalField)]
[(keyword "iso" (name k)) v]))
(static-instances ChronoField)
{:week-fields/iso-week-based-year (.weekBasedYear WeekFields/ISO)
:week-fields/iso-week-of-month (.weekOfMonth WeekFields/ISO)
:week-fields/iso-week-of-week-based-year (.weekOfWeekBasedYear WeekFields/ISO)
:week-fields/iso-week-of-year (.weekOfYear WeekFields/ISO)}
{:week-fields/week-based-year (.weekBasedYear WeekFields/SUNDAY_START)
:week-fields/week-of-month (.weekOfMonth WeekFields/SUNDAY_START)
:week-fields/week-of-week-based-year (.weekOfWeekBasedYear WeekFields/SUNDAY_START)
:week-fields/week-of-year (.weekOfYear WeekFields/SUNDAY_START)})) |
Standard (non-DST) offset for a time zone, for cases when we don't have date information. Gets the offset for the
given We don't know what zone offset to shift this to, since the offset for a zone-id can vary depending on the date part of a temporal value (e.g. DST vs non-DST). So just adjust to the non-DST "standard" offset for the zone in question. | (defn standard-offset ^ZoneOffset [^ZoneId zone-id] (.. zone-id getRules (getStandardOffset (t/instant (t/offset-date-time (-> (t/zoned-date-time) t/year t/value) 1 1))))) |
(ns metabase.util.date-2.parse (:require [clojure.string :as str] [java-time.api :as t] [metabase.util.date-2.common :as u.date.common] [metabase.util.date-2.parse.builder :as b] [metabase.util.i18n :refer [tru]] [schema.core :as s]) (:import (java.time LocalDateTime OffsetDateTime OffsetTime ZonedDateTime ZoneOffset) (java.time.format DateTimeFormatter) (java.time.temporal Temporal TemporalAccessor TemporalField TemporalQueries))) | |
(set! *warn-on-reflection* true) | |
(def ^:private ^{:arglists '([temporal-accessor query])} query
(let [queries {:local-date (TemporalQueries/localDate)
:local-time (TemporalQueries/localTime)
:zone-offset (TemporalQueries/offset)
:zone-id (TemporalQueries/zoneId)}]
(fn [^TemporalAccessor temporal-accessor query]
(.query temporal-accessor (queries query))))) | |
(defn- normalize [s]
(-> s
;; HACK - haven't figured out how to get the parser builder to allow HHmm offsets (i.e., no colons) yet, so add
;; one in there if needed. TODO - what about HH:mm:ss offsets? Will we ever see those?
(str/replace #"([+-][0-2]\d)([0-5]\d)$" "$1:$2")
(str/replace #"([0-2]\d:[0-5]\d(?::[0-5]\d(?:\.\d{1,9})?)?[+-][0-2]\d$)" "$1:00"))) | |
Returns a map of supported temporal field lisp-style name -> value, e.g. (parse-special-case (.parse (b/formatter (b/value :year 4) (b/value :iso/week-of-year 2)) "201901")) ;; -> {:year 2019, :iso-week-of-year 1} | (defn all-supported-fields
[^TemporalAccessor temporal-accessor]
(into {} (for [[k ^TemporalField field] u.date.common/temporal-field
:when (.isSupported temporal-accessor field)]
[k (.getLong temporal-accessor field)]))) |
(s/defn parse-with-formatter :- (s/maybe Temporal)
"Parse a String with a DateTimeFormatter, returning an appropriate instance of an `java.time` temporal class."
[formattr s :- (s/maybe s/Str)]
{:pre [((some-fn string? nil?) s)]}
(when-not (str/blank? s)
(let [formattr (t/formatter formattr)
s (normalize s)
temporal-accessor (.parse formattr s)
local-date (query temporal-accessor :local-date)
local-time (query temporal-accessor :local-time)
zone-offset (query temporal-accessor :zone-offset)
zone-id (or (query temporal-accessor :zone-id)
(when (= zone-offset ZoneOffset/UTC)
(t/zone-id "UTC")))
literal-type [(cond
zone-id :zone
zone-offset :offset
:else :local)
(cond
(and local-date local-time) :datetime
local-date :date
local-time :time)]]
(case literal-type
[:zone :datetime] (ZonedDateTime/of local-date local-time zone-id)
[:offset :datetime] (OffsetDateTime/of local-date local-time zone-offset)
[:local :datetime] (LocalDateTime/of local-date local-time)
[:zone :date] (ZonedDateTime/of local-date (t/local-time 0) zone-id)
[:offset :date] (OffsetDateTime/of local-date (t/local-time 0) zone-offset)
[:local :date] local-date
[:zone :time] (OffsetTime/of local-time (or zone-offset (u.date.common/standard-offset zone-id)))
[:offset :time] (OffsetTime/of local-time zone-offset)
[:local :time] local-time
(throw (ex-info (tru "Don''t know how to parse {0} using format {1}" (pr-str s) (pr-str formattr))
{:s s
:formatter formattr
:supported-fields (all-supported-fields temporal-accessor)})))))) | |
(def ^:private ^DateTimeFormatter date-formatter*
(b/formatter
(b/value :year 4 10 :exceeds-pad)
(b/optional
"-"
(b/value :month-of-year 2)
(b/optional
"-"
(b/value :day-of-month 2)))
(b/default-value :month-of-year 1)
(b/default-value :day-of-month 1))) | |
(def ^:private ^DateTimeFormatter time-formatter*
(b/formatter
(b/value :hour-of-day 2)
(b/optional
":"
(b/value :minute-of-hour 2)
(b/optional
":"
(b/value :second-of-minute 2)
(b/optional
(b/fraction :nano-of-second 0 9, :decimal-point? true))))
(b/default-value :minute-of-hour 0)
(b/default-value :second-of-minute 0)
(b/default-value :nano-of-second 0))) | |
(def ^:private ^DateTimeFormatter offset-formatter*
(b/formatter
(b/optional " ")
(b/optional
(b/zone-offset))
(b/optional
(b/zone-id)))) | |
(def ^:private ^DateTimeFormatter formatter
(b/formatter
(b/case-insensitive
(b/optional
date-formatter*)
(b/optional "T")
(b/optional " ")
(b/optional
time-formatter*)
(b/optional
offset-formatter*)))) | |
Parse a string into a | (defn parse [^String s] (parse-with-formatter formatter s)) |
Utility functions for programatically building a The basic idea here is you pass a number of TODO - this is a prime library candidate. | (ns metabase.util.date-2.parse.builder (:require [metabase.util.date-2.common :as u.date.common]) (:import (java.time.format DateTimeFormatter DateTimeFormatterBuilder SignStyle) (java.time.temporal TemporalField))) |
(set! *warn-on-reflection* true) | |
(defprotocol ^:private Section (^:private apply-section [this builder])) | |
(extend-protocol Section
String
(apply-section [s builder]
(.appendLiteral ^DateTimeFormatterBuilder builder s))
clojure.lang.Fn
(apply-section [f builder]
(f builder))
clojure.lang.Sequential
(apply-section [sections builder]
(doseq [section sections]
(apply-section section builder)))
DateTimeFormatter
(apply-section [formatter builder]
(.append ^DateTimeFormatterBuilder builder formatter))) | |
Make wrapped | (defn optional
[& sections]
(reify Section
(apply-section [_ builder]
(.optionalStart ^DateTimeFormatterBuilder builder)
(apply-section sections builder)
(.optionalEnd ^DateTimeFormatterBuilder builder)))) |
(defn- set-option [^DateTimeFormatterBuilder builder option]
(case option
:strict (.parseStrict builder)
:lenient (.parseLenient builder)
:case-sensitive (.parseCaseSensitive builder)
:case-insensitive (.parseCaseInsensitive builder))) | |
(def ^:private ^:dynamic *options*
{:strictness :strict
:case-sensitivity :case-sensitive}) | |
(defn- do-with-option [builder k new-value thunk]
(let [old-value (get *options* k)]
(if (= old-value new-value)
(thunk)
(binding [*options* (assoc *options* k new-value)]
(set-option builder new-value)
(thunk)
(set-option builder old-value))))) | |
(defn- with-option-section [k v sections]
(reify Section
(apply-section [_ builder]
(do-with-option builder k v (fn [] (apply-section sections builder)))))) | |
Use strict parsing for wrapped | (defn strict [& sections] (with-option-section :strictness :strict sections)) |
Use lenient parsing for wrapped | (defn lenient [& sections] (with-option-section :strictness :lenient sections)) |
Make wrapped | (defn case-sensitive [& sections] (with-option-section :case-sensitivity :case-sensitive sections)) |
Make wrapped | (defn case-insensitive [& sections] (with-option-section :case-sensitivity :case-insensitive sections)) |
(def ^:private ^SignStyle sign-style (u.date.common/static-instances SignStyle)) | |
(defn- temporal-field ^TemporalField [x]
(let [field (if (keyword? x)
(u.date.common/temporal-field x)
x)]
(assert (instance? TemporalField field)
(format "Invalid TemporalField: %s" (pr-str field)))
field)) | |
Define a section for a specific field such as | (defn value
([temporal-field-name]
(fn [^DateTimeFormatterBuilder builder]
(.appendValue builder (temporal-field temporal-field-name))))
([temporal-field-name width]
(fn [^DateTimeFormatterBuilder builder]
(.appendValue builder (temporal-field temporal-field-name) width)))
([temporal-field-name min-val max-val sign-style-name]
(fn [^DateTimeFormatterBuilder builder]
(.appendValue builder (temporal-field temporal-field-name) min-val max-val (sign-style sign-style-name))))) |
Define a section that sets a default value for a field like | (defn default-value
[temporal-field-name default-value]
(fn [^DateTimeFormatterBuilder builder]
(.parseDefaulting builder (temporal-field temporal-field-name) default-value))) |
Define a section for a fractional value, e.g. milliseconds or nanoseconds. | (defn fraction
[temporal-field-name _min-val-width _max-val-width & {:keys [decimal-point?]}]
(fn [^DateTimeFormatterBuilder builder]
(.appendFraction builder (temporal-field temporal-field-name) 0 9 (boolean decimal-point?)))) |
Define a section for a timezone offset. e.g. | (defn zone-offset
[]
(lenient
(fn [^DateTimeFormatterBuilder builder]
(.appendOffsetId builder)))) |
An a section for a timezone ID wrapped in square brackets, e.g. | (defn zone-id
[]
(strict
(case-sensitive
(optional "[")
(fn [^DateTimeFormatterBuilder builder]
(.appendZoneRegionId builder))
(optional "]")))) |
Return a new (formatter (case-insensitive (value :hour-of-day 2) (optional ":" (value :minute-of-hour 2) (optional ":" (value :second-of-minute))))) -> #object[java.time.format.DateTimeFormatter "ParseCaseSensitive(false)Value(HourOfDay,2)[':'Value(MinuteOfHour,2)[':'Value(SecondOfMinute)]]"] | (defn formatter
^DateTimeFormatter [& sections]
(let [builder (DateTimeFormatterBuilder.)]
(apply-section sections builder)
(.toFormatter builder))) |
Utility functions for public links and embedding. | (ns metabase.util.embed (:require [buddy.core.codecs :as codecs] [buddy.sign.jwt :as jwt] [cheshire.core :as json] [clojure.string :as str] [hiccup.core :refer [html]] [metabase.config :as config] [metabase.models.setting :as setting :refer [defsetting]] [metabase.public-settings :as public-settings] [metabase.public-settings.premium-features :as premium-features] [metabase.util :as u] [metabase.util.i18n :refer [deferred-tru trs tru]] [ring.util.codec :as codec])) |
(set! *warn-on-reflection* true) | |
--------------------------------------------- PUBLIC LINKS UTIL FNS ---------------------------------------------- | |
Return an oEmbed URL for the (oembed-url "/x") -> "http://localhost:3000/api/public/oembed?url=x&format=json" | (defn- oembed-url
^String [^String relative-url]
(str (public-settings/site-url)
"/api/public/oembed"
;; NOTE: some oEmbed consumers require `url` be the first param???
"?url=" (codec/url-encode (str (public-settings/site-url) relative-url))
"&format=json")) |
Returns a | (defn- oembed-link
^String [^String url]
(html [:link {:rel "alternate"
:type "application/json+oembed"
:href (oembed-url url)
:title "Metabase"}])) |
A | (def ^:private ^:const ^String embedly-meta
(html [:meta {:name "generator", :content "Metabase"}])) |
Returns the | (defn head ^String [^String url] (str embedly-meta (oembed-link url))) |
Return an | (defn iframe
^String [^String url, width height]
(html [:iframe {:src url
:width width
:height height
:frameborder 0}])) |
----------------------------------------------- EMBEDDING UTIL FNS ----------------------------------------------- | |
(defsetting embedding-secret-key
(deferred-tru "Secret key used to sign JSON Web Tokens for requests to `/api/embed` endpoints.")
:visibility :admin
:audit :no-value
:setter (fn [new-value]
(when (seq new-value)
(assert (u/hexadecimal-string? new-value)
(tru "Invalid embedding-secret-key! Secret key must be a hexadecimal-encoded 256-bit key (i.e., a 64-character string).")))
(setting/set-value-of-type! :string :embedding-secret-key new-value))) | |
Parse a JWT | (defn- jwt-header
[^String message]
(let [[header] (str/split message #"\.")]
(json/parse-string (codecs/bytes->str (codec/base64-decode header)) keyword))) |
Check that the JWT | (defn- check-valid-alg
[^String message]
(let [{:keys [alg]} (jwt-header message)]
(when-not alg
(throw (Exception. (trs "JWT is missing `alg`."))))
(when (= alg "none")
(throw (Exception. (trs "JWT `alg` cannot be `none`.")))))) |
Parse a "signed" (base-64 encoded) JWT and return a Clojure representation. Check that the signature is
valid (i.e., check that it was signed with | (defn unsign
[^String message]
(when (seq message)
(try
(check-valid-alg message)
(jwt/unsign message
(or (embedding-secret-key)
(throw (ex-info (tru "The embedding secret key has not been set.") {:status-code 400})))
;; The library will reject tokens with a created at timestamp in the future, so to account for clock
;; skew tell the library to allow for 60 seconds of leeway
{:leeway 60})
;; if `jwt/unsign` throws an Exception rethrow it in a format that's friendlier to our API
(catch Throwable e
(throw (ex-info (.getMessage e) {:status-code 400})))))) |
Find | (defn get-in-unsigned-token-or-throw
[unsigned-token keyseq]
(or (get-in unsigned-token keyseq)
(throw (ex-info (tru "Token is missing value for keypath {0}" keyseq) {:status-code 400})))) |
(defsetting show-static-embed-terms
(deferred-tru "Check if the static embedding licensing should be hidden in the static embedding flow")
:type :boolean
:default true
:export? true
:getter (fn []
(if-not (and config/ee-available? (:valid (premium-features/token-status)))
(setting/get-value-of-type :boolean :show-static-embed-terms)
false))) | |
Utility functions for encrypting and decrypting strings using AES256 CBC + HMAC SHA512 and the
| (ns metabase.util.encryption (:require [buddy.core.codecs :as codecs] [buddy.core.crypto :as crypto] [buddy.core.kdf :as kdf] [buddy.core.nonce :as nonce] [clojure.string :as str] [environ.core :as env] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [ring.util.codec :as codec])) |
(set! *warn-on-reflection* true) | |
Generate a 64-byte byte array hash of | (defn secret-key->hash
^bytes [^String secret-key]
(kdf/get-bytes (kdf/engine {:alg :pbkdf2+sha512
:key secret-key
:iterations 100000}) ; 100,000 iterations takes about ~160ms on my laptop
64)) |
Check the minimum length of the key and hash it for internal usage. | (defn validate-and-hash-secret-key
[^String secret-key]
(when-let [secret-key secret-key]
(when (seq secret-key)
(assert (>= (count secret-key) 16)
(str (trs "MB_ENCRYPTION_SECRET_KEY must be at least 16 characters.")))
(secret-key->hash secret-key)))) |
apperently if you're not tagging in an arglist, | (defonce ^:private ^{:tag 'bytes} default-secret-key
(validate-and-hash-secret-key (env/env :mb-encryption-secret-key))) |
log a nice message letting people know whether DB details encryption is enabled | (when-not *compile-files*
(log/info
(if default-secret-key
(trs "Saved credentials encryption is ENABLED for this Metabase instance.")
(trs "Saved credentials encryption is DISABLED for this Metabase instance."))
(u/emoji (if default-secret-key "🔐" "🔓"))
"\n"
(trs "For more information, see")
"https://metabase.com/docs/latest/operations-guide/encrypting-database-details-at-rest.html")) |
Encrypt bytes | (defn encrypt-bytes
{:added "0.41.0"}
(^String [^bytes b]
(encrypt-bytes default-secret-key b))
(^String [^String secret-key, ^bytes b]
(let [initialization-vector (nonce/random-bytes 16)]
(->> (crypto/encrypt b
secret-key
initialization-vector
{:algorithm :aes256-cbc-hmac-sha512})
(concat initialization-vector)
byte-array)))) |
Encrypt string | (defn encrypt
(^String [^String s]
(encrypt default-secret-key s))
(^String [^String secret-key, ^String s]
(->> (codecs/to-bytes s)
(encrypt-bytes secret-key)
codec/base64-encode))) |
Decrypt bytes | (defn decrypt-bytes
{:added "0.41.0"}
(^String [^bytes b]
(decrypt-bytes default-secret-key b))
(^String [secret-key, ^bytes b]
(let [[initialization-vector message] (split-at 16 b)]
(crypto/decrypt (byte-array message)
secret-key
(byte-array initialization-vector)
{:algorithm :aes256-cbc-hmac-sha512})))) |
Decrypt string | (defn decrypt (^String [^String s] (decrypt default-secret-key s)) (^String [secret-key, ^String s] (codecs/bytes->str (decrypt-bytes secret-key (codec/base64-decode s))))) |
If | (defn maybe-encrypt
(^String [^String s]
(maybe-encrypt default-secret-key s))
(^String [secret-key, ^String s]
(if secret-key
(when (seq s)
(encrypt secret-key s))
s))) |
If | (defn maybe-encrypt-bytes
{:added "0.41.0"}
(^bytes [^bytes b]
(maybe-encrypt-bytes default-secret-key b))
(^bytes [secret-key, ^bytes b]
(if secret-key
(when (seq b)
(encrypt-bytes secret-key b))
b))) |
(def ^:private ^:const aes256-tag-length 32) (def ^:private ^:const aes256-block-size 16) | |
Returns true if it's likely that | (defn possibly-encrypted-bytes?
[^bytes b]
(if (nil? b)
false
(u/ignore-exceptions
(when-let [byte-length (alength b)]
(zero? (mod (- byte-length aes256-tag-length)
aes256-block-size)))))) |
Returns true if it's likely that | (defn possibly-encrypted-string?
[^String s]
(u/ignore-exceptions
(when-let [b (and (not (str/blank? s))
(u/base64-string? s)
(codec/base64-decode s))]
(possibly-encrypted-bytes? b)))) |
If | (defn maybe-decrypt
{:arglists '([secret-key? s])}
[& args]
;; secret-key as an argument so that tests can pass it directly without using `with-redefs` to run in parallel
(let [[secret-key v] (if (and (bytes? (first args)) (string? (second args)))
args
(cons default-secret-key args))
log-error-fn (fn [kind ^Throwable e]
(log/warnf e
"Cannot decrypt encrypted %s. Have you changed or forgot to set MB_ENCRYPTION_SECRET_KEY?"
kind))]
(cond (nil? secret-key)
v
(possibly-encrypted-string? v)
(try
(decrypt secret-key v)
(catch Throwable e
;; if we can't decrypt `v`, but it *is* probably encrypted, log a warning
(log-error-fn "String" e)
v))
(possibly-encrypted-bytes? v)
(try
(decrypt-bytes secret-key v)
(catch Throwable e
;; if we can't decrypt `v`, but it *is* probably encrypted, log a warning
(log-error-fn "bytes" e)
v))
:else
v))) |
Low-level file-related functions for implementing Metabase plugin functionality. These use the As much as possible, this namespace aims to abstract away the | (ns metabase.util.files
(:require
[babashka.fs :as fs]
[clojure.java.io :as io]
[clojure.string :as str]
[metabase.util :as u]
[metabase.util.i18n :refer [trs]]
[metabase.util.log :as log])
(:import
(java.io FileNotFoundException)
(java.net URL)
(java.nio.file CopyOption Files FileSystem FileSystemAlreadyExistsException FileSystems
LinkOption OpenOption Path Paths StandardCopyOption)
(java.nio.file.attribute FileAttribute)
(java.util Collections)
(java.util.zip ZipInputStream))) |
(set! *warn-on-reflection* true) | |
--------------------------------------------------- Path Utils --------------------------------------------------- | |
(defn- get-path-in-filesystem ^Path [^FileSystem filesystem ^String path-component & more-components] (.getPath filesystem path-component (u/varargs String more-components))) | |
Get a (get-path "/Users/cam/metabase/metabase/plugins") ;; -> #object[sun.nio.fs.UnixPath 0x4d378139 "/Users/cam/metabase/metabase/plugins"] | (defn get-path ^Path [& path-components] (apply get-path-in-filesystem (FileSystems/getDefault) path-components)) |
Appends string | (defn append-to-path
^Path [^Path path & components]
(loop [^Path path path, [^String component & more] components]
(let [path (.resolve path component)]
(if-not (seq more)
path
(recur path more))))) |
----------------------------------------------- Other Basic Utils ------------------------------------------------ | |
Does file at | (defn exists? [^Path path] (Files/exists path (u/varargs LinkOption))) |
True if | (defn regular-file? [^Path path] (Files/isRegularFile path (u/varargs LinkOption))) |
True if we can read the file at | (defn readable? [^Path path] (Files/isReadable path)) |
----------------------------------------------- Working with Dirs ------------------------------------------------ | |
Self-explanatory. Create a directory with | (defn create-dir-if-not-exists!
[^Path path]
(when-let [parent (fs/parent path)]
(create-dir-if-not-exists! parent))
(when-not (exists? path)
(Files/createDirectory path (u/varargs FileAttribute)))) |
Get a sequence of all files in | (defn files-seq [^Path path] (iterator-seq (.iterator (Files/list path)))) |
------------------------------------------------- Copying Stuff -------------------------------------------------- | |
(defn- last-modified-timestamp ^java.time.Instant [^Path path]
(when (exists? path)
(.toInstant (Files/getLastModifiedTime path (u/varargs LinkOption))))) | |
Copy a file from | (defn copy-file!
[^Path source ^Path dest]
(when (or (not (exists? dest))
(not= (last-modified-timestamp source) (last-modified-timestamp dest)))
(log/info (trs "Extract file {0} -> {1}" source dest))
(Files/copy source dest (u/varargs CopyOption [StandardCopyOption/REPLACE_EXISTING
StandardCopyOption/COPY_ATTRIBUTES])))) |
Copy all files in | (defn copy-files!
[^Path source-dir, ^Path dest-dir]
(doseq [^Path source (files-seq source-dir)
:let [target (append-to-path dest-dir (str (.getFileName source)))]]
(try
(copy-file! source target)
(catch Throwable e
(log/error e (trs "Failed to copy file")))))) |
------------------------------------------ Opening filesystems for URLs ------------------------------------------ | |
(defn- url-inside-jar? [^URL url]
(when url
(str/includes? (.getFile url) ".jar!/"))) | |
(defn- jar-file-system-from-url ^FileSystem [^URL url]
(let [uri (.toURI url)]
(try
(FileSystems/newFileSystem uri Collections/EMPTY_MAP)
(catch FileSystemAlreadyExistsException _
(log/info "File system at" uri "already exists")
(FileSystems/getFileSystem uri))))) | |
Impl for | (defn do-with-open-path-to-resource
[^String resource f]
(let [url (io/resource resource)]
(when-not url
(throw (FileNotFoundException. (trs "Resource does not exist."))))
(if (url-inside-jar? url)
(with-open [fs (jar-file-system-from-url url)]
(f (get-path-in-filesystem fs "/" resource)))
(f (get-path (.toString (Paths/get (.toURI url)))))))) |
Execute Throws a FileNotFoundException if the resource does not exist; be sure to check with (with-open-path-to-resouce [path "modules"] ...) | (defmacro with-open-path-to-resource
[[path-binding resource-filename-str] & body]
`(do-with-open-path-to-resource
~resource-filename-str
(fn [~(vary-meta path-binding assoc :tag java.nio.file.Path)]
~@body))) |
+----------------------------------------------------------------------------------------------------------------+ | JAR FILE CONTENTS | +----------------------------------------------------------------------------------------------------------------+ | |
True is a file exists in an archive. | (defn file-exists-in-archive?
[^Path archive-path & path-components]
(with-open [fs (FileSystems/newFileSystem archive-path (ClassLoader/getSystemClassLoader))]
(let [file-path (apply get-path-in-filesystem fs path-components)]
(exists? file-path)))) |
Read the entire contents of a file from a archive (such as a JAR). | (defn slurp-file-from-archive
[^Path archive-path & path-components]
(with-open [fs (FileSystems/newFileSystem archive-path (ClassLoader/getSystemClassLoader))]
(let [file-path (apply get-path-in-filesystem fs path-components)]
(when (exists? file-path)
(with-open [is (Files/newInputStream file-path (u/varargs OpenOption))]
(slurp is)))))) |
Decompress a zip archive from input to output. | (defn unzip-file
[zip-file mod-fn]
(with-open [stream (-> zip-file io/input-stream ZipInputStream.)]
(loop [entry (.getNextEntry stream)]
(when entry
(let [out-path (mod-fn (.getName entry))
out-file (io/file out-path)]
(if (.isDirectory entry)
(when-not (.exists out-file) (.mkdirs out-file))
(let [parent-dir (fs/parent out-path)]
(when-not (fs/exists? (str parent-dir)) (fs/create-dirs parent-dir))
(io/copy stream out-file)))
(recur (.getNextEntry stream))))))) |
Returns a java.nio.file.Path | (defn relative-path [path] (fs/relativize (fs/absolutize ".") path)) |
font loading functionality. | (ns metabase.util.fonts (:require [clojure.string :as str] [metabase.util :as u] [metabase.util.files :as u.files] [metabase.util.log :as log])) |
Use a font's directory to derive a Display Name by changing underscores to spaces. | (defn- normalize-font-dirname [dirname] (str/replace dirname #"_" " ")) |
(defn- contains-font-file? [path] ;; todo: expand this to allow other font formats? (boolean (some #(str/includes? % ".woff") (u.files/files-seq path)))) | |
(defn- available-fonts*
[]
(u.files/with-open-path-to-resource [font-path "frontend_client/app/fonts"]
(let [font-path-str (str font-path "/")]
(log/info (str "Reading available fonts from " font-path))
(->> font-path
u.files/files-seq
(filter contains-font-file?)
(map #(str/replace (str %) font-path-str ))
(map normalize-font-dirname)
(sort-by u/lower-case-en))))) | |
Return an alphabetically sorted list of available fonts, as Strings. | (def ^{:arglists '([])} available-fonts
(let [fonts (delay (available-fonts*))]
(fn [] @fonts))) |
True if a font's 'Display String', | (defn available-font? [font] (boolean ((set (available-fonts)) font))) |
Honey SQL 2 utilities and extra registered functions/operators. | (ns ^{:added "0.46.0"} metabase.util.honey-sql-2
(:refer-clojure
:exclude
[+ - / * abs mod inc dec cast concat format second])
(:require
[clojure.string :as str]
[honey.sql :as sql]
[honey.sql.protocols :as sql.protocols]
[metabase.util :as u]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[potemkin.types :as p.types])
(:import
(java.util Locale))) |
(set! *warn-on-reflection* true) | |
`[:inline [:/ 4 (/ 1 3)] => 4 / 1 / 3 is a different result than [:/ 4 (/ 1 3)] => 4 / (1 / 3) See #28354 | (extend-protocol sql.protocols/InlineValue
clojure.lang.Ratio
(sqlize [this]
(let [numerator (.numerator ^clojure.lang.Ratio this)
denominator (.denominator ^clojure.lang.Ratio this)]
(clojure.core/format "(%d.0 / %d.0)" numerator denominator)))) |
Use this function when you need to upper-case an identifier or table name. Similar to | (defn- english-upper-case [^CharSequence s] (-> s str (.toUpperCase Locale/ENGLISH))) |
(sql/register-dialect!
:h2
(update (sql/get-dialect :ansi) :quote (fn [quote]
(comp english-upper-case quote)))) | |
this is mostly a convenience for tests, disables quoting completely. | (sql/register-dialect! ::unquoted-dialect (assoc (sql/get-dialect :ansi) :quote identity)) |
(sql/format-expr [::extract :a :b]) => "extract(a from b)" register the | (defn- format-extract
[_tag [unit expr]]
(let [[sql & args] (sql/format-expr expr {:nested true})]
(into [(clojure.core/format "extract(%s from %s)" (name unit) sql)]
args))) |
(sql/register-fn! ::extract #'format-extract) | |
Create a Honey SQL form that will compile to SQL like extract(unit FROM expr) | (defn extract
[unit expr]
;; make sure no one tries to be sneaky and pass some sort of malicious unit in.
{:pre [(some-fn keyword? string?) (re-matches #"^[a-zA-Z0-9]+$" (name unit))]}
[::extract unit expr]) |
(sql/format-expr [::h2x/distinct-count :x]) => count(distinct x) register the function | (defn- format-distinct-count
[_tag [expr]]
(let [[sql & args] (sql/format-expr expr)]
(into [(str "count(distinct " sql ")")]
args))) |
(sql/register-fn! ::distinct-count #'format-distinct-count) | |
(hsql/format (sql/call :percentile-cont :a 0.9)) => "percentile_cont(0.9) within group (order by a)" register the function | (defn- format-percentile-cont
[_tag [expr p]]
(let [p (if (number? p)
[:inline p]
p)
[expr-sql & expr-args] (sql/format-expr expr)
[p-sql & p-args] (sql/format-expr p)]
(into [(clojure.core/format "PERCENTILE_CONT(%s) within group (order by %s)" p-sql expr-sql)]
cat
[expr-args
p-args]))) |
(sql/register-fn! ::percentile-cont #'format-percentile-cont) | |
Malli schema for valid [[identifier]] types. | (def IdentifierType [:enum :database :schema :constraint :index ;; Suppose we have a query like: ;; SELECT my_field f FROM my_table t ;; then: :table ; is `my_table` :table-alias ; is `t` :field ; is `my_field` :field-alias ; is `f` ;; for [[quoted-cast]] :type-name]) |
Whether | (defn identifier?
[x]
(and (vector? x)
(= (first x) ::identifier))) |
Malli schema for an [[identifier]]. | (def Identifier
[:tuple
[:= ::identifier]
IdentifierType
[:sequential {:min 1} :string]]) |
(defn- format-identifier [_tag [_identifier-type components :as _args]]
;; don't error if the identifier has something 'suspicious' like a semicolon in it -- it's ok because we're quoting
;; everything
(binding [sql/*allow-suspicious-entities* true]
[(str/join \. (map (fn [component]
;; `:aliased` `true` => don't split dots in the middle of components
(sql/format-entity component {:aliased true}))
components))])) | |
(sql/register-fn! ::identifier #'format-identifier) | |
Define an identifier of type with
This function automatically unnests any Identifiers passed as arguments, removes nils, and converts all args to strings. | (mu/defn identifier
[identifier-type :- IdentifierType
& components :- [:* {:min 1} [:maybe [:or :keyword ms/NonBlankString [:fn identifier?]]]]]
[::identifier
identifier-type
(vec (for [component components
component (if (identifier? component)
(last component)
[component])
:when (some? component)]
(u/qualified-name component)))]) |
(mu/defn identifier->components :- [:sequential string?] "Given an identifer return its components (identifier->components (identifier :field :metabase :user :email)) => (\"metabase\" \"user\" \"email\")) " [identifier :- [:fn identifier?]] (last identifier)) | |
Single-quoted string literal | |
(defn- escape-and-quote-literal [s]
(as-> s s
(str/replace s #"(?<![\\'])'(?![\\'])" "''")
(str \' s \'))) | |
(defn- format-literal [_tag [s]] [(escape-and-quote-literal s)]) | |
(sql/register-fn! ::literal #'format-literal) | |
Wrap keyword or string We'll try to escape single quotes in the literal, unless they're already escaped (either as DON'T USE | (defn literal "Wrap keyword or string `s` in single quotes and a HoneySQL `raw` form. We'll try to escape single quotes in the literal, unless they're already escaped (either as `''` or as `\\`, but this won't handle wacky cases like three single quotes in a row. DON'T USE `LITERAL` FOR THINGS THAT MIGHT BE WACKY (USER INPUT). Only use it for things that are hardcoded." [s] [::literal (u/qualified-name s)]) |
(defn- format-at-time-zone [_tag [expr zone]]
(let [[expr-sql & expr-args] (sql/format-expr expr {:nested true})
[zone-sql & zone-args] (sql/format-expr (literal zone))]
(into [(clojure.core/format "(%s AT TIME ZONE %s)"
expr-sql
zone-sql)]
cat
[expr-args zone-args]))) | |
(sql/register-fn! ::at-time-zone #'format-at-time-zone) | |
Create a Honey SQL form that returns | (defn at-time-zone [expr zone] [::at-time-zone expr zone]) |
Protocol for a HoneySQL form that has type information such as | (p.types/defprotocol+ TypedHoneySQL
(type-info [honeysql-form]
"Return type information associated with `honeysql-form`, if any (i.e., if it is a `TypedHoneySQLForm`); otherwise
returns `nil`.")
(with-type-info [honeysql-form new-type-info]
"Add type information to a `honeysql-form`. Wraps `honeysql-form` and returns a `TypedHoneySQLForm`.")
(unwrap-typed-honeysql-form [honeysql-form]
"If `honeysql-form` is a `TypedHoneySQLForm`, unwrap it and return the original form without type information.
Otherwise, returns form as-is.")) |
(defn- format-typed [_tag [expr _type-info]]
(sql/format-expr expr {:nested true})) | |
(sql/register-fn! ::typed #'format-typed) | |
(def ^:private NormalizedTypeInfo
[:map
[:database-type
{:optional true}
[:and
ms/NonBlankString
[:fn
{:error/message "lowercased string"}
(fn [s]
(= s (u/lower-case-en s)))]]]]) | |
(mu/defn ^:private normalize-type-info :- NormalizedTypeInfo
"Normalize the values in the `type-info` for a `TypedHoneySQLForm` for easy comparisons (e.g., normalize
`:database-type` to a lower-case string)."
[type-info]
(cond-> type-info
(:database-type type-info)
(update :database-type (comp u/lower-case-en name)))) | |
(defn- typed? [x]
(and (vector? x)
(= (first x) ::typed))) | |
(extend-protocol TypedHoneySQL
Object
(type-info [_]
nil)
(with-type-info [this new-info]
[::typed this (normalize-type-info new-info)])
(unwrap-typed-honeysql-form [this]
this)
nil
(type-info [_]
nil)
(with-type-info [_ new-info]
[::typed nil (normalize-type-info new-info)])
(unwrap-typed-honeysql-form [_]
nil)
clojure.lang.IPersistentVector
(type-info [this]
(when (typed? this)
(last this)))
(with-type-info [this new-info]
[::typed
(if (typed? this)
(clojure.core/second this)
this)
(normalize-type-info new-info)])
(unwrap-typed-honeysql-form [this]
(if (typed? this)
(clojure.core/second this)
this))) | |
For a given type-info, returns the | (defn type-info->db-type
[type-info]
{:added "0.39.0"}
(:database-type type-info)) |
Returns the | (defn database-type [honeysql-form] (some-> honeysql-form type-info type-info->db-type)) |
Is (is-of-type? expr "datetime") ; -> true (is-of-type? expr #"int*") ; -> true | (defn is-of-type?
[honeysql-form db-type]
(let [form-type (some-> honeysql-form database-type u/lower-case-en)]
(if (instance? java.util.regex.Pattern db-type)
(and (some? form-type) (some? (re-find db-type form-type)))
(= form-type
(some-> db-type name u/lower-case-en))))) |
Convenience for adding only database type information to a (with-database-type-info :field "text") ;; -> [::typed :field "text"] | (mu/defn with-database-type-info
{:style/indent [:form]}
[honeysql-form db-type :- [:maybe ms/KeywordOrString]]
(if (some? db-type)
(with-type-info honeysql-form {:database-type db-type})
(unwrap-typed-honeysql-form honeysql-form))) |
(def ^:private TypedExpression
[:fn {:error/message "::h2x/typed Honey SQL form"} typed?]) | |
(mu/defn cast :- TypedExpression
"Generate a statement like `cast(expr AS sql-type)`. Returns a typed HoneySQL form."
[db-type expr]
(-> [:cast expr [:raw (name db-type)]]
(with-database-type-info db-type))) | |
(mu/defn quoted-cast :- TypedExpression
"Generate a statement like `cast(expr AS \"sql-type\")`.
Like `cast` but quotes `sql-type`. This is useful for cases where we deal with user-defined types or other types
that may have a space in the name, for example Postgres enum types.
Returns a typed HoneySQL form."
[sql-type :- ms/NonBlankString expr]
(-> [:cast expr (identifier :type-name sql-type)]
(with-database-type-info sql-type))) | |
(mu/defn maybe-cast :- TypedExpression
"Cast `expr` to `sql-type`, unless `expr` is typed and already of that type. Returns a typed HoneySQL form."
[sql-type expr]
(if (is-of-type? expr sql-type)
expr
(cast sql-type expr))) | |
Cast ;; cast to TIMESTAMP unless form is already a TIMESTAMP, TIMESTAMPTZ, or DATE (cast-unless-type-in "timestamp" #{"timestamp" "timestamptz" "date"} form) | (defn cast-unless-type-in
{:added "0.42.0"}
[desired-type acceptable-types expr]
{:pre [(string? desired-type) (set? acceptable-types)]}
(if (some (partial is-of-type? expr)
acceptable-types)
expr
(cast desired-type expr))) |
(defn- math-operator [operator]
(fn [& args]
(let [arg-db-type (some (fn [arg]
(-> arg type-info type-info->db-type))
args)]
(cond-> (into [operator]
(map (fn [arg]
(if (number? arg)
[:inline arg]
arg)))
args)
arg-db-type (with-database-type-info arg-db-type))))) | |
Math operator. Interpose Math operator. Interpose Math operator. Interpose Math operator. Interpose Math operator. Interpose | (def ^{:arglists '([& exprs])} + (math-operator :+))
(def ^{:arglists '([& exprs])} - (math-operator :-))
(def ^{:arglists '([& exprs])} / (math-operator :/))
(def ^{:arglists '([& exprs])} * (math-operator :*))
(def ^{:arglists '([& exprs])} mod (math-operator :%)) |
Add 1 to Subtract 1 from | (defn inc [x] (+ x 1)) (defn dec [x] (- x 1)) |
SQL | (defn format [format-str expr] (sql/call :format expr (literal format-str))) |
SQL | (defn round [x decimal-places] (sql/call :round x decimal-places)) |
CAST CAST CAST CAST CAST CAST CAST | (defn ->date [x] (maybe-cast :date x)) (defn ->datetime [x] (maybe-cast :datetime x)) (defn ->timestamp [x] (maybe-cast :timestamp x)) (defn ->timestamp-with-time-zone [x] (maybe-cast "timestamp with time zone" x)) (defn ->integer [x] (maybe-cast :integer x)) (defn ->time [x] (maybe-cast :time x)) (defn ->boolean [x] (maybe-cast :boolean x)) |
SQL Random SQL fns. Not all DBs support all these! SQL SQL SQL SQL SQL SQL SQL SQL SQL SQL SQL | (def ^{:arglists '([& exprs])} abs (partial sql/call :abs))
(def ^{:arglists '([& exprs])} ceil (partial sql/call :ceil))
(def ^{:arglists '([& exprs])} floor (partial sql/call :floor))
(def ^{:arglists '([& exprs])} second (partial sql/call :second))
(def ^{:arglists '([& exprs])} minute (partial sql/call :minute))
(def ^{:arglists '([& exprs])} hour (partial sql/call :hour))
(def ^{:arglists '([& exprs])} day (partial sql/call :day))
(def ^{:arglists '([& exprs])} week (partial sql/call :week))
(def ^{:arglists '([& exprs])} month (partial sql/call :month))
(def ^{:arglists '([& exprs])} quarter (partial sql/call :quarter))
(def ^{:arglists '([& exprs])} year (partial sql/call :year))
(def ^{:arglists '([& exprs])} concat (partial sql/call :concat)) |
(ns metabase.util.humanization (:require [clojure.string :as str] [metabase.util :as u])) | |
Convert a name, such as (name->human-readable-name :simple "cool_toucans") ;-> "Cool Toucans" ;; specifiy a different strategy: (name->human-readable-name :none "cooltoucans") ;-> "cooltoucans" | (defmulti name->human-readable-name
{:arglists '([strategy s])}
(fn [strategy _s]
(keyword strategy))) |
(def ^:private ^:const acronyms
#{"id" "url" "ip" "uid" "uuid" "guid"}) | |
(defn- capitalize-word [word]
(if (contains? acronyms (u/lower-case-en word))
(u/upper-case-en word)
;; We are assuming that ALL_UPPER_CASE means we should be Title Casing
(if (= word (u/upper-case-en word))
(str/capitalize word)
(str (str/capitalize (subs word 0 1)) (subs word 1))))) | |
simple replaces hyphens and underscores with spaces and capitalizes | (defmethod name->human-readable-name :simple
[_strategy s]
;; explode on hyphens, underscores, and spaces
(when (seq s)
(let [humanized (str/join " " (for [part (str/split s #"[-_\s]+")
:when (not (str/blank? part))]
(capitalize-word part)))]
(if (str/blank? humanized)
s
humanized)))) |
| (defmethod name->human-readable-name :none [_strategy s] s) |
i18n functionality. | (ns metabase.util.i18n (:require [cheshire.generate :as json.generate] [clojure.string :as str] [clojure.walk :as walk] [metabase.util.i18n.impl :as i18n.impl] [metabase.util.log :as log] [potemkin :as p] [potemkin.types :as p.types] [schema.core :as s]) (:import (java.text MessageFormat) (java.util Locale))) |
(set! *warn-on-reflection* true) | |
(p/import-vars [i18n.impl available-locale? fallback-locale locale normalized-locale-string translate]) | |
Bind this to a string, keyword, or | (def ^:dynamic *user-locale* nil) |
Bind this to a string, keyword to override the value returned by | (def ^:dynamic *site-locale-override* nil) |
The default locale string for this Metabase installation. Normally this is the value of the | (defn site-locale-string
[]
(or *site-locale-override*
(i18n.impl/site-locale-from-setting)
"en")) |
Locale string we should use for the current User (e.g. | (defn user-locale-string
[]
(or *user-locale*
(site-locale-string))) |
The default locale for this Metabase installation. Normally this is the value of the | (defn site-locale ^Locale [] (locale (site-locale-string))) |
Locale we should use for the current User (e.g. | (defn user-locale ^Locale [] (locale (user-locale-string))) |
Returns all locale abbreviations and their full names | (defn available-locales-with-names
[]
(for [locale-name (i18n.impl/available-locale-names)]
;; Abbreviation must be normalized or the language picker will show incorrect saved value
;; because the locale is normalized before saving (metabase#15657, metabase#16654)
[(normalized-locale-string locale-name) (.getDisplayName (locale locale-name))])) |
Translate a string with the System locale. | (defn- translate-site-locale
[format-string args pluralization-opts]
(let [translated (translate (site-locale) format-string args pluralization-opts)]
(log/tracef "Translated %s for site locale %s -> %s"
(pr-str format-string) (pr-str (site-locale-string)) (pr-str translated))
translated)) |
Translate a string with the current User's locale. | (defn- translate-user-locale
[format-string args pluralization-opts]
(let [translated (translate (user-locale) format-string args pluralization-opts)]
(log/tracef "Translating %s for user locale %s (site locale %s) -> %s"
(pr-str format-string) (pr-str (user-locale-string))
(pr-str (site-locale-string)) (pr-str translated))
translated)) |
(p.types/defrecord+ UserLocalizedString [format-string args pluralization-opts]
Object
(toString [_]
(translate-user-locale format-string args pluralization-opts))
schema.core.Schema
(explain [this]
(str this))) | |
(p.types/defrecord+ SiteLocalizedString [format-string args pluralization-opts]
Object
(toString [_]
(translate-site-locale format-string args pluralization-opts))
s/Schema
(explain [this]
(str this))) | |
Write a UserLocalizedString or SiteLocalizedString to the | (defn- localized-to-json [localized-string json-generator] (json.generate/write-string json-generator (str localized-string))) |
(json.generate/add-encoder UserLocalizedString localized-to-json) (json.generate/add-encoder SiteLocalizedString localized-to-json) | |
Schema for user and system localized string instances | (def LocalizedString (s/cond-pre UserLocalizedString SiteLocalizedString)) |
(defn- valid-str-form? [str-form] (and (= (first str-form) 'str) (every? string? (rest str-form)))) | |
Make sure the right number of args were passed to | (defn- validate-number-of-args
[format-string-or-str args]
(let [format-string (cond
(string? format-string-or-str) format-string-or-str
(valid-str-form? format-string-or-str) (apply str (rest format-string-or-str))
:else (assert false "The first arg to (deferred-)trs/tru must be a String or a valid `str` form with String arguments!"))
message-format (MessageFormat. format-string)
;; number of {n} placeholders in format string including any you may have skipped. e.g. "{0} {2}" -> 3
expected-num-args-by-index (count (.getFormatsByArgumentIndex message-format))
;; number of {n} placeholders in format string *not* including ones you make have skipped. e.g. "{0} {2}" -> 2
expected-num-args (count (.getFormats message-format))
actual-num-args (count args)]
(assert (= expected-num-args expected-num-args-by-index)
(format "(deferred-)trs/tru with format string %s is missing some {} placeholders. Expected %s. Did you skip any?"
(pr-str (.toPattern message-format))
(str/join ", " (map (partial format "{%d}") (range expected-num-args-by-index)))))
(assert (= expected-num-args actual-num-args)
(str (format (str "(deferred-)trs/tru with format string %s expects %d args, got %d.")
(pr-str (.toPattern message-format)) expected-num-args actual-num-args)
" Did you forget to escape a single quote?")))) |
Similar to The first argument can be a format string, or a valid Calling | (defmacro deferred-tru
[format-string-or-str & args]
(validate-number-of-args format-string-or-str args)
`(UserLocalizedString. ~format-string-or-str ~(vec args) {})) |
Similar to The first argument can be a format string, or a valid Calling | (defmacro deferred-trs
[format-string & args]
(validate-number-of-args format-string args)
`(SiteLocalizedString. ~format-string ~(vec args) {})) |
Ensures that | (def ^String ^{:arglists '([& args])} str*
(if *compile-files*
(fn [& _]
(throw (Exception. "Premature i18n string lookup. Is there a top-level call to `trs` or `tru`?")))
str)) |
Applies The first argument can be a format string, or a valid Prefer this over | (defmacro tru [format-string-or-str & args] `(str* (deferred-tru ~format-string-or-str ~@args))) |
Applies The first argument can be a format string, or a valid Prefer this over | (defmacro trs [format-string-or-str & args] `(str* (deferred-trs ~format-string-or-str ~@args))) |
Make sure that | (defn- validate-n
[format-string format-string-pl]
(assert (and (string? format-string) (string? format-string-pl))
"The first and second args to (deferred-)trsn/trun must be Strings!")
(let [validate (fn [format-string]
(let [message-format (MessageFormat. format-string)
;; number of {n} placeholders in format string including any you may have skipped. e.g. "{0} {2}" -> 3
num-args-by-index (count (.getFormatsByArgumentIndex message-format))
;; number of {n} placeholders in format string *not* including ones you make have skipped. e.g. "{0} {2}" -> 2
num-args (count (.getFormats message-format))]
(assert (and (<= num-args-by-index 1) (<= num-args 1))
(format "(deferred-)trsn/trun only supports a single {0} placeholder for the value `n`"))))]
(validate format-string)
(validate format-string-pl))) |
Similar to The first argument should be the singular form; the second argument should be the plural form, and the third argument
should be (deferred-trun "{0} table" "{0} tables" n) | (defmacro deferred-trun
[format-string format-string-pl n]
(validate-n format-string format-string-pl)
`(UserLocalizedString. ~format-string ~[n] ~{:n n :format-string-pl format-string-pl})) |
Similar to The first argument should be the singular form; the second argument should be the plural form, and the third argument
should be (trun "{0} table" "{0} tables" n) | (defmacro trun [format-string format-string-pl n] `(str* (deferred-trun ~format-string ~format-string-pl ~n))) |
Similar to The first argument should be the singular form; the second argument should be the plural form, and the third argument
should be (deferred-trsn "{0} table" "{0} tables" n) | (defmacro deferred-trsn
[format-string format-string-pl n]
(validate-n format-string format-string-pl)
`(SiteLocalizedString. ~format-string ~[n] ~{:n n :format-string-pl format-string-pl})) |
Similar to The first argument should be the singular form; the second argument should be the plural form, and the third argument
should be (trsn "{0} table" "{0} tables" n) | (defmacro trsn [format-string format-string-pl n] `(str* (deferred-trsn ~format-string ~format-string-pl ~n))) |
Returns true if | (defn localized-string? [x] (boolean (some #(instance? % x) [UserLocalizedString SiteLocalizedString]))) |
Walks the datastructure | (defn localized-strings->strings
[x]
(walk/postwalk (fn [node]
(cond-> node
(localized-string? node) str))
x)) |
Lower-level implementation functions for | (ns metabase.util.i18n.impl (:require [clojure.java.io :as io] [clojure.string :as str] [clojure.tools.reader.edn :as edn] [metabase.plugins.classloader :as classloader] [metabase.util.i18n.plural :as i18n.plural] [metabase.util.log :as log] [potemkin.types :as p.types]) (:import (java.text MessageFormat) (java.util Locale) (org.apache.commons.lang3 LocaleUtils))) |
(set! *warn-on-reflection* true) | |
Protocol for anything that can be coerced to a | (p.types/defprotocol+ CoerceToLocale
(locale ^java.util.Locale [this]
"Coerce `this` to a `java.util.Locale`.")) |
Normalize a locale string to the canonical format. (normalized-locale-string "EN-US") ;-> "en_US" Returns | (defn normalized-locale-string
^String [s]
{:pre [((some-fn nil? string?) s)]}
#_{:clj-kondo/ignore [:discouraged-var]}
(when (string? s)
(when-let [[_ language country] (re-matches #"^(\w{2})(?:[-_](\w{2}))?$" s)]
(let [language (str/lower-case language)]
(if country
(str language \_ (some-> country str/upper-case))
language))))) |
(extend-protocol CoerceToLocale
nil
(locale [_] nil)
Locale
(locale [this] this)
String
(locale [^String s]
(some-> (normalized-locale-string s) LocaleUtils/toLocale))
;; Support namespaced keywords like `:en/US` and `:en/UK` because we can
clojure.lang.Keyword
(locale [this]
(locale (if-let [namespce (namespace this)]
(str namespce \_ (name this))
(name this))))) | |
True if | (defn available-locale?
[locale-or-name]
(boolean
(when-let [locale (locale locale-or-name)]
(LocaleUtils/isAvailableLocale locale)))) |
(defn- available-locale-names* [] (log/info "Reading available locales from locales.clj...") (some-> (io/resource "locales.clj") slurp edn/read-string :locales (->> (apply sorted-set)))) | |
Return sorted set of available locales, as Strings. (available-locale-names) ; -> #{"en" "nl" "pt-BR" "zh"} | (def ^{:arglists '([])} available-locale-names
(let [locales (delay (available-locale-names*))]
(fn [] @locales))) |
(defn- find-fallback-locale*
^Locale [^Locale a-locale]
(some (fn [locale-name]
(let [try-locale (locale locale-name)]
;; The language-only Locale is tried first by virtue of the
;; list being sorted.
(when (and (= (.getLanguage try-locale) (.getLanguage a-locale))
(not (= try-locale a-locale)))
try-locale)))
(available-locale-names))) | |
(def ^:private ^{:arglists '([a-locale])} find-fallback-locale
(memoize find-fallback-locale*)) | |
Find a translated fallback Locale in the following order:
1) If it is a language + country Locale, try the language-only Locale
2) If the language-only Locale isn't translated or the input is a language-only Locale,
find the first language + country Locale we have a translation for.
Return (fallback-locale "en_US") ; -> #locale"en" (fallback-locale "pt") ; -> #locale"pt_BR" (fallback-locale "ptPT") ; -> #locale"ptBR" | (defn fallback-locale
^Locale [locale-or-name]
(when-let [a-locale (locale locale-or-name)]
(find-fallback-locale a-locale))) |
The resource URL for the edn file containing translations for (locale-edn-resources "es") ;-> #object[java.net.URL "file:/home/cam/metabase/resources/metabase/es.edn"] | (defn- locale-edn-resource
^java.net.URL [locale-or-name]
(when-let [a-locale (locale locale-or-name)]
(let [locale-name (-> (normalized-locale-string (str a-locale))
(str/replace #"_" "-"))
filename (format "i18n/%s.edn" locale-name)]
(io/resource filename (classloader/the-classloader))))) |
(defn- translations* [a-locale]
(when-let [resource (locale-edn-resource a-locale)]
(edn/read-string (slurp resource)))) | |
Fetch a map of original untranslated message format string -> translated message format string for (translations "es") ;-> {:headers { ... } :messages {"Username" "Nombre Usuario", ...}} | (def ^:private ^{:arglists '([locale-or-name])} translations
(comp (memoize translations*) locale)) |
Find the translated version of
| (defn- translated-format-string*
^String [locale-or-name format-string n]
(when (seq format-string)
(when-let [locale (locale locale-or-name)]
(when-let [translations (translations locale)]
(when-let [string-or-strings (get-in translations [:messages format-string])]
(if (string? string-or-strings)
;; Only a singular form defined; ignore `n`
string-or-strings
(if-let [plural-forms-header (get-in translations [:headers "Plural-Forms"])]
(get string-or-strings (i18n.plural/index plural-forms-header n))
;; Fall-back to singular if no header is present
(first string-or-strings)))))))) |
Find the translated version of | (defn- translated-format-string
^String [locale-or-name format-string {:keys [n format-string-pl]}]
(when-let [a-locale (locale locale-or-name)]
(or (when (= (.getLanguage a-locale) "en")
(if (or (nil? n) (= n 1))
format-string
format-string-pl))
(translated-format-string* a-locale format-string n)
(when-let [fallback-locale (fallback-locale a-locale)]
(log/tracef "No translated string found, trying fallback locale %s" (pr-str fallback-locale))
(translated-format-string* fallback-locale format-string n))
format-string))) |
(defn- message-format ^MessageFormat [locale-or-name ^String format-string pluralization-opts]
(or (when-let [a-locale (locale locale-or-name)]
(when-let [^String translated (translated-format-string a-locale format-string pluralization-opts)]
(MessageFormat. translated a-locale)))
(MessageFormat. format-string))) | |
Find the translated version of
Will attempt to translate (translate "es-MX" "must be {0} characters or less" 140) ; -> "deben tener 140 caracteres o menos" | (defn translate
([locale-or-name ^String format-string]
(translate locale-or-name format-string []))
([locale-or-name ^String format-string args]
(translate locale-or-name format-string args {}))
([locale-or-name ^String format-string args pluralization-opts]
(when (seq format-string)
(try
(.format (message-format locale-or-name format-string pluralization-opts) (to-array args))
(catch Throwable e
;; Not translating this string to prevent an unfortunate stack overflow. If this string happened to be the one
;; that had the typo, we'd just recur endlessly without logging an error.
(log/errorf e "Unable to translate string %s to %s" (pr-str format-string) (str locale-or-name))
(try
(.format (MessageFormat. format-string) (to-array args))
(catch Throwable _
(log/errorf e "Invalid format string %s" (pr-str format-string))
format-string))))))) |
Whether we're currently inside a call to [[site-locale-from-setting]], so we can prevent infinite recursion. | (def ^:private ^:dynamic *in-site-locale-from-setting* false) |
Fetch the value of the | (defn site-locale-from-setting
[]
(when-let [get-value-of-type (resolve 'metabase.models.setting/get-value-of-type)]
(when (bound? get-value-of-type)
;; make sure we don't try to recursively fetch the site locale when we're actively in the process of fetching it,
;; otherwise that will cause infinite loops if we try to log anything... see #32376
(when-not *in-site-locale-from-setting*
(binding [*in-site-locale-from-setting* true]
;; if there is an error fetching the Setting, e.g. if the app DB is in the process of shutting down, then just
;; return nil.
(try
(get-value-of-type :string :site-locale)
(catch Exception _
nil))))))) |
(defmethod print-method Locale [locale ^java.io.Writer writer] ((get-method print-dup Locale) locale writer)) | |
(defmethod print-dup Locale [locale ^java.io.Writer writer] (.write writer (format "#locale %s" (pr-str (str locale))))) | |
Resources for parsing the Plural-Forms header from a translation file and determining which of multiple pluralities to use for a translated string. | (ns metabase.util.i18n.plural (:require [clojure.core.memoize :as memoize] [instaparse.core :as insta])) |
This is a parser for the C-like syntax used to express pluralization rules in the Plural-Forms header in translation files. For example, the Plural-Forms header for Czech is: See the original gettext docs for more details on how pluralization rules work: https://www.gnu.org/software/gettext/manual/html_node/Plural-forms.html Operators with LOWER precedence are defined HIGHER in the grammar, and vice versa. A The | (def ^:private plural-form-parser
(insta/parser
"expr = <s> maybe-ternary <s> <';'>? <s>
<maybe-ternary> = ternary | maybe-or
ternary = maybe-or <s> <'?'> <s> maybe-ternary <s> <':'> <s> maybe-ternary
<maybe-or> = or-expr | maybe-and
or-expr = maybe-or <s> <'||'> <s> maybe-and
<maybe-and> = and-expr | maybe-eq
and-expr = maybe-and <s> <'&&'> <s> maybe-eq
<maybe-eq> = eq-expr | neq-expr | maybe-comp
eq-expr = maybe-eq <s> <'=='> <s> maybe-comp
neq-expr = maybe-eq <s> <'!='> <s> maybe-comp
<maybe-comp> = lt-expr | lte-expr | gt-expr | gte-expr | maybe-add
lt-expr = maybe-comp <s> <'<'> <s> maybe-add
lte-expr = maybe-comp <s> <'<='> <s> maybe-add
gt-expr = maybe-comp <s> <'>'> <s> maybe-add
gte-expr = maybe-comp <s> <'>='> <s> maybe-add
<maybe-add> = add-expr | sub-expr | maybe-mult
add-expr = maybe-add <s> <'+'> <s> maybe-mult
sub-expr = maybe-add <s> <'-'> <s> maybe-mult
<maybe-mult> = mult-expr | div-expr | mod-expr | operand
mult-expr = maybe-mult <s> <'*'> <s> operand
div-expr = maybe-mult <s> <'/'> <s> operand
mod-expr = maybe-mult <s> <'%'> <s> operand
<operand> = integer | variable | parens
<parens> = <'('> <s> expr <s> <')'>
<s> = <#'\\s+'>*
integer = #'[0-9]+'
variable = 'n'")) |
Converts an integer or Boolean to a Boolean to use in a C-style logical operator. | (defn- to-bool
[x]
(if (integer? x)
(if (= x 0) false true)
x)) |
Converts an integer or Boolean to an integer to use in a C-style arithmetic operator. | (defn- to-int
[x]
(if (boolean? x)
(if x 1 0)
x)) |
Converts a Clojure binary function f to a C-style operator that treats Booleans as integers, and returns an integer. | (defn- op [f] (fn [x y] (to-int (f (to-int x) (to-int y))))) |
Functions to use for each tag in the parse tree, when transforming the tree into a single value. | (defn- tag-fns
[n]
{:add-expr (op +)
:sub-expr (op -)
:mult-expr (op *)
:div-expr (op /)
:mod-expr (op mod)
:eq-expr (op =)
:neq-expr (op not=)
:gt-expr (op >)
:gte-expr (op >=)
:lt-expr (op <)
:lte-expr (op <=)
:and-expr #(to-int (and (to-bool %1) (to-bool %2)))
:or-expr #(to-int (or (to-bool %1) (to-bool %2)))
:ternary #(to-int (if (to-bool %1) %2 %3))
:integer #(Integer. ^String %)
:variable (constantly n)
:expr identity}) |
Returns the index of the correct translated string for a given value n, based on the value of the Plural-Forms header for a locale. Memoized to improve performance for cases where a single string is translated with a limited range of possible
values of | (def index
(memoize/lu
(fn [plural-forms-header n]
(let [formula (second (re-find #"plural=(.*)" plural-forms-header))
tree (insta/parse plural-form-parser formula)]
(insta/transform (tag-fns n) tree)))
{}
;; This cache size is pretty arbitrary; can be tweaked if necessary
:lu/threshold 500)) |
JVM-specific utilities and helpers. You don't want to import this namespace directly - these functions are re-exported by [[metabase.util]]. | (ns metabase.util.jvm (:require [clojure.java.classpath :as classpath] [clojure.string :as str] [clojure.tools.namespace.find :as ns.find] [metabase.shared.util.i18n :refer [tru]] [metabase.util.format :as u.format] [metabase.util.log :as log] [nano-id.core :as nano-id]) (:import (java.net InetAddress InetSocketAddress Socket) (java.util Base64 Base64$Decoder Base64$Encoder Locale PriorityQueue Random) (java.util.concurrent TimeoutException))) |
(set! *warn-on-reflection* true) | |
Generates a random NanoID string. Usually these are used for the entity_id field of various models. If an argument is provided, it's taken to be an identity-hash string and used to seed the RNG, producing the same value every time. | (defn generate-nano-id
([] (nano-id/nano-id))
([seed-str]
(let [seed (Long/parseLong seed-str 16)
rnd (Random. seed)
gen (nano-id/custom
"_-0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
21
(fn [len]
(let [ba (byte-array len)]
(.nextBytes rnd ba)
ba)))]
(gen)))) |
Make a properly-tagged Java interop varargs argument. This is basically the same as (u/varargs String) (u/varargs String ["A" "B"]) | (defmacro varargs
{:style/indent 1, :arglists '([klass] [klass xs])}
[klass & [objects]]
(vary-meta `(into-array ~klass ~objects)
assoc :tag (format "[L%s;" (.getTypeName ^Class (ns-resolve *ns* klass))))) |
Timeout (in ms) for checking if a host is available with | (def ^:private ^:const host-up-timeout 5000) |
Returns true if the port is active on a given host, false otherwise | (defn host-port-up?
[^String hostname, ^Integer port]
(try
(let [sock-addr (InetSocketAddress. hostname port)]
(with-open [sock (Socket.)]
(.connect sock sock-addr host-up-timeout)
true))
(catch Throwable _ false))) |
Returns true if the host given by hostname is reachable, false otherwise | (defn host-up?
[^String hostname]
(try
(let [host-addr (InetAddress/getByName hostname)]
(.isReachable host-addr host-up-timeout))
(catch Throwable _ false))) |
(defprotocol ^:private IFilteredStacktrace
(filtered-stacktrace [this]
"Get the stack trace associated with E and return it as a vector with non-metabase frames after the last Metabase
frame filtered out.")) | |
(extend-protocol IFilteredStacktrace
nil
(filtered-stacktrace [_] nil)
Throwable
(filtered-stacktrace [^Throwable this]
(filtered-stacktrace (.getStackTrace this)))
Thread
(filtered-stacktrace [^Thread this]
(filtered-stacktrace (.getStackTrace this)))) | |
(extend (Class/forName "[Ljava.lang.StackTraceElement;")
IFilteredStacktrace
{:filtered-stacktrace
(fn [this]
;; keep all the frames before the last Metabase frame, but then filter out any other non-Metabase frames after
;; that
(let [[frames-after-last-mb other-frames] (split-with #(not (str/includes? % "metabase"))
(seq this))
[last-mb-frame & frames-before-last-mb] (for [frame other-frames
:when (str/includes? frame "metabase")]
(str/replace frame #"^metabase\." ""))]
(vec
(concat
(map str frames-after-last-mb)
;; add a little arrow to the frame so it stands out more
(cons
(some->> last-mb-frame (str "--> "))
frames-before-last-mb)))))}) | |
Whether string | (defn ip-address?
[s]
(and (string? s)
(.isValid (org.apache.commons.validator.routines.InetAddressValidator/getInstance) ^String s))) |
A reducing function that maintains a queue of the largest items as determined by In general, (= (take-last 2 (sort-by identity kompare coll)) (transduce (map identity) (u/sorted-take 2 kompare) coll)) But the entire collection is not in memory, just at most | (defn sorted-take
[size kompare]
(fn bounded-heap-acc
([] (PriorityQueue. size kompare))
([^PriorityQueue q]
(loop [acc []]
(if-let [x (.poll q)]
(recur (conj acc x))
acc)))
([^PriorityQueue q item]
(if (>= (.size q) size)
(let [smallest (.peek q)]
(if (pos? (kompare item smallest))
(doto q
(.poll)
(.offer item))
q))
(doto q
(.offer item)))))) |
Gather the full exception chain into a sequence. | (defn full-exception-chain
[e]
(when (instance? Throwable e)
(take-while some? (iterate ex-cause e)))) |
Like (def e (ex-info "A" {:a true, :both "a"} (ex-info "B" {:b true, :both "A"}))) (ex-data e) ;; -> {:a true, :both "a"} (u.jvm/all-ex-data e) ;; -> {:a true, :b true, :both "a"} | (defn all-ex-data
[e]
(reduce
(fn [data e]
(merge (ex-data e) data))
nil
(full-exception-chain e))) |
Execute Consider using the For implementing more fine grained retry policies like exponential backoff,
consider using the | (defn do-with-auto-retries
{:style/indent 1}
[num-retries f]
(if (<= num-retries 0)
(f)
(try
(f)
(catch Throwable e
(when (::no-auto-retry? (all-ex-data e))
(throw e))
(log/warn (u.format/format-color 'red "auto-retry %s: %s" f (.getMessage e)))
(do-with-auto-retries (dec num-retries) f))))) |
Execute You can disable auto-retries for a specific ExceptionInfo by including For implementing more fine grained retry policies like exponential backoff,
consider using the | (defmacro auto-retry
{:style/indent 1}
[num-retries & body]
`(do-with-auto-retries ~num-retries
(fn [] ~@body))) |
A shared Base64 decoder instance. | (def ^:private ^Base64$Decoder base64-decoder (Base64/getDecoder)) |
Decodes a Base64 string into bytes. | (defn decode-base64-to-bytes ^bytes [^String string] (.decode base64-decoder string)) |
Decodes the Base64 string TODO -- this is only used [[metabase.analytics.snowplow-test]] these days | (defn decode-base64 [input] (new java.lang.String (decode-base64-to-bytes input) "UTF-8")) |
A shared Base64 encoder instance. | (def ^:private ^Base64$Encoder base64-encoder (Base64/getEncoder)) |
Encodes the UTF-8 encoding of the string | (defn encode-base64 ^String [^String input] (.encodeToString base64-encoder (.getBytes input "UTF-8"))) |
(def ^:private do-with-us-locale-lock (Object.)) | |
Implementation for | (defn do-with-us-locale
[f]
;; Since I'm 99% sure default Locale isn't thread-local we better put a lock in place here so we don't end up with
;; the following race condition:
;;
;; Thread 1 ....*.............................*........................*...........*
;; ^getDefault() -> Turkish ^setDefault(US) ^(f) ^setDefault(Turkish)
;; Thread 2 ....................................*....................*................*......*
;; ^getDefault() -> US ^setDefault(US) ^(f) ^setDefault(US)
(locking do-with-us-locale-lock
(let [original-locale (Locale/getDefault)]
(try
(Locale/setDefault Locale/US)
(f)
(finally
(Locale/setDefault original-locale)))))) |
Execute ;; Locale is Turkish / -Duser.language=tr (.toUpperCase "filename") ;; -> "FİLENAME" Rather than submit PRs to every library in the world to use Note that because DO NOT use this macro in API endpoints or other places that are multithreaded or performance will be negatively
impacted. (You shouldn't have a good reason for using this there anyway. Rewrite your code to pass | (defmacro with-us-locale
{:style/indent 0}
[& body]
`(do-with-us-locale (fn [] ~@body))) |
Vector of symbols of all Metabase namespaces, excluding test namespaces. This is intended for use by various routines that load related namespaces, such as task and events initialization. This is made | (defonce ^:const
metabase-namespace-symbols
(vec (sort (for [ns-symb (ns.find/find-namespaces (classpath/system-classpath))
:when (and (str/starts-with? ns-symb "metabase")
(not (str/includes? ns-symb "test")))]
ns-symb)))) |
Call | (defn deref-with-timeout
[reff timeout-ms]
(let [result (deref reff timeout-ms ::timeout)]
(when (= result ::timeout)
(when (future? reff)
(future-cancel reff))
(throw (TimeoutException. (tru "Timed out after {0}" (u.format/format-milliseconds timeout-ms)))))
result)) |
Impl for | (defn do-with-timeout
[timeout-ms f]
(try
(deref-with-timeout (future-call f) timeout-ms)
(catch java.util.concurrent.ExecutionException e
(throw (.getCause e))))) |
Run | (defmacro with-timeout [timeout-ms & body] `(do-with-timeout ~timeout-ms (fn [] ~@body))) |
(ns metabase.util.log (:require [goog.log :as glog] [goog.string :as gstring] [goog.string.format :as gstring.format] [lambdaisland.glogi :as log] [lambdaisland.glogi.console :as glogi-console]) (:require-macros [metabase.util.log])) | |
The formatting functionality is only loaded if you depend on goog.string.format. | (comment gstring.format/keep-me) |
(glogi-console/install!)
(log/set-levels {:glogi/root :info}) | |
Part of the internals of [[glogi-logp]] etc. | #_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
(defn is-loggable?
[logger-name level]
(glog/isLoggable (log/logger logger-name) (log/level level))) |
Part of the internals of [[logf]]. | #_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
(defn format-msg
[fmt & args]
(apply gstring/format fmt args)) |
Converts our standard | (defn glogi-level
[level]
(if (= level :fatal)
:shout
level)) |
Common logging interface that wraps clojure.tools.logging in JVM Clojure and Glogi in CLJS. The interface is the same as [[clojure.tools.logging]]. | (ns metabase.util.log
(:require
[clojure.pprint :as pprint]
[clojure.string :as str]
#_{:clj-kondo/ignore [:discouraged-namespace]}
[clojure.tools.logging]
[clojure.tools.logging.impl]
[net.cgrand.macrovich :as macros])) |
Macro helper for [[logp]] in CLJS. --------------------------------------------- CLJ-side macro helpers --------------------------------------------- | (defn- glogi-logp
[logger-name level x more]
`(let [level# (glogi-level ~level)
logger# ~logger-name]
(when (is-loggable? logger# level#)
(let [x# ~x]
(if (instance? js/Error x#)
(lambdaisland.glogi/log logger# level# (print-str ~@more) x#)
(lambdaisland.glogi/log logger# level# (print-str x# ~@more) nil)))))) |
Macro helper for [[logf]] in CLJS. | (defn- glogi-logf
[logger-name level x more]
`(let [level# (glogi-level ~level)
logger# ~logger-name]
(when (is-loggable? logger# level#)
(let [x# ~x]
(if (instance? js/Error x#)
(lambdaisland.glogi/log logger# level# (format-msg ~@more) x#)
(lambdaisland.glogi/log logger# level# (format-msg x# ~@more) nil)))))) |
Macro helper for [[spy]] and [[spyf]] in CLJS. | (defn- glogi-spy
[logger-name level expr formatter]
`(let [level# (glogi-level ~level)
logger# ~logger-name]
(when (is-loggable? logger# level#)
(let [a# ~expr
s# (~formatter a#)]
(lambdaisland.glogi/log logger# level# nil s#)
a#)))) |
Macro helper for [[logp]] in CLJ. | (defn- tools-logp
[logger-ns level x more]
`(let [logger# (clojure.tools.logging.impl/get-logger clojure.tools.logging/*logger-factory* ~logger-ns)]
(when (clojure.tools.logging.impl/enabled? logger# ~level)
(let [x# ~x]
(if (instance? Throwable x#)
(clojure.tools.logging/log* logger# ~level x# ~(if (nil? more)
""
`(print-str ~@more)))
(clojure.tools.logging/log* logger# ~level nil (print-str x# ~@more))))))) |
Macro helper for [[logf]] in CLJ. | (defn- tools-logf
[logger-ns level x more]
(if (and (instance? String x) (nil? more))
;; Simple case: just a String and no args.
`(let [logger# (clojure.tools.logging.impl/get-logger clojure.tools.logging/*logger-factory* ~logger-ns)]
(when (clojure.tools.logging.impl/enabled? logger# ~level)
(clojure.tools.logging/log* logger# ~level nil ~x)))
;; Full case, with formatting.
`(let [logger# (clojure.tools.logging.impl/get-logger clojure.tools.logging/*logger-factory* ~logger-ns)]
(when (clojure.tools.logging.impl/enabled? logger# ~level)
(let [x# ~x]
(if (instance? Throwable x#)
(clojure.tools.logging/log* logger# ~level x# (format ~@more))
(clojure.tools.logging/log* logger# ~level nil (format x# ~@more)))))))) |
Implementation for prn-style ------------------------------------------------ Internal macros ------------------------------------------------- | (defmacro logp
{:arglists '([level message & more] [level throwable message & more])}
[level x & more]
(macros/case
:cljs (glogi-logp (str *ns*) level x more)
:clj (tools-logp *ns* level x more))) |
Implementation for printf-style | (defmacro logf
[level x & args]
(macros/case
:cljs (glogi-logf (str *ns*) level x args)
:clj (tools-logf *ns* level x args))) |
Log one or more args at the --------------------------------------------------- Public API --------------------------------------------------- | (defmacro trace
{:arglists '([& args] [e & args])}
[& args]
`(logp :trace ~@args)) |
Log a message at the | (defmacro tracef
{:arglists '([format-string & args] [e format-string & args])}
[& args]
`(logf :trace ~@args)) |
Log one or more args at the | (defmacro debug
{:arglists '([& args] [e & args])}
[& args]
`(logp :debug ~@args)) |
Log a message at the | (defmacro debugf
{:arglists '([format-string & args] [e format-string & args])}
[& args]
`(logf :debug ~@args)) |
Log one or more args at the | (defmacro info
{:arglists '([& args] [e & args])}
[& args]
`(logp :info ~@args)) |
Log a message at the | (defmacro infof
{:arglists '([format-string & args] [e format-string & args])}
[& args]
`(logf :info ~@args)) |
Log one or more args at the | (defmacro warn
{:arglists '([& args] [e & args])}
[& args]
`(logp :warn ~@args)) |
Log a message at the | (defmacro warnf
{:arglists '([format-string & args] [e format-string & args])}
[& args]
`(logf :warn ~@args)) |
Log one or more args at the | (defmacro error
{:arglists '([& args] [e & args])}
[& args]
`(logp :error ~@args)) |
Log a message at the | (defmacro errorf
{:arglists '([format-string & args] [e format-string & args])}
[& args]
`(logf :error ~@args)) |
Log one or more args at the | #_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
(defmacro fatal
{:arglists '([& args] [e & args])}
[& args]
`(logp :fatal ~@args)) |
Log a message at the | (defmacro fatalf
{:arglists '([format-string & args] [e format-string & args])}
[& args]
`(logf :fatal ~@args)) |
Evaluates an expression, and may write both the form and its result to the log.
Returns the result of | (defmacro spy
([expr] `(spy :debug ~expr))
([level expr]
(macros/case
:cljs (glogi-spy (str *ns*) level expr
#(str/trim-newline
(with-out-str
#_{:clj-kondo/ignore [:discouraged-var]}
(pprint/with-pprint-dispatch pprint/code-dispatch
(pprint/pprint '~expr)
(print "=> ")
(pprint/pprint %)))))
:clj `(clojure.tools.logging/spy ~level ~expr)))) |
Evaluates an expression, and may write both the form and its formatted result to the log.
Defaults to the | #_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
(defmacro spyf
([fmt expr]
`(spyf :debug ~fmt ~expr))
([level fmt expr]
(macros/case
:cljs (glogi-spy (str *ns*) level expr #(format ~fmt %))
:clj `(spyf ~level ~fmt ~expr)))) |
Turns off logs in body. | (defmacro with-no-logs
[& body]
`(binding [clojure.tools.logging/*logger-factory* clojure.tools.logging.impl/disabled-logger-factory]
~@body)) |
(ns metabase.util.malli.defn (:refer-clojure :exclude [defn]) (:require [clojure.string :as str] [malli.destructure] [metabase.util :as u] [metabase.util.malli.fn :as mu.fn] [net.cgrand.macrovich :as macros])) | |
TODO -- this should generate type hints from the schemas and from the return type as well. | (defn- deparameterized-arglist [{:keys [args]}]
(-> (malli.destructure/parse args)
:arglist
(with-meta (meta args)))) |
(defn- deparameterized-arglists [{:keys [arities], :as _parsed}]
(let [[arities-type arities-value] arities]
(case arities-type
:single (list (deparameterized-arglist arities-value))
:multiple (map deparameterized-arglist (:arities arities-value))))) | |
Generate a docstring with additional information about inputs and return type using a parsed fn tail (as parsed by [[mx/SchematizedParams]]). | (defn- annotated-docstring
[{original-docstring :doc
[arities-type arities-value] :arities
:keys [return]
:as _parsed}]
(str/trim
(str "Inputs: " (case arities-type
:single (pr-str (:args arities-value))
:multiple (str "("
(str/join "\n "
(map (comp pr-str :args)
(:arities arities-value)))
")"))
"\n Return: " (str/replace (u/pprint-to-str (:schema return :any))
"\n"
(str "\n "))
(when (not-empty original-docstring)
(str "\n\n " original-docstring))))) |
Implementation of [[metabase.util.malli/defn]]. Like [[schema.core/defn]], but for Malli. Doesn't Malli already have a version of this in [[malli.experimental]]? It does, but it tends to eat memory; see https://metaboat.slack.com/archives/CKZEMT1MJ/p1690496060299339 and #32843 for more information. This new implementation solves most of our memory consumption problems. Unless it's in a skipped namespace during prod, (see: [[mu.fn/instrument-ns?]]) this macro emits clojure code to validate its inputs and outputs based on its malli schema annotations. Example macroexpansion: (mu/defn f :- :int [x :- :int] (inc x)) ;; => (def f (let [&f (fn [x] (inc x))] (fn ([a] (metabase.util.malli.fn/validate-input :int a) (->> (&f a) (metabase.util.malli.fn/validate-output :int)))))) Known issue: does not currently generate automatic type hints the way [[schema.core/defn]] does, nor does it attempt to preserve them if you specify them manually. We can fix this in the future. | (defmacro defn
[& [fn-name :as fn-tail]]
(let [parsed (mu.fn/parse-fn-tail fn-tail)
{attr-map :meta} parsed
attr-map (merge
{:arglists (list 'quote (deparameterized-arglists parsed))
:schema (mu.fn/fn-schema parsed)}
attr-map)
docstring (annotated-docstring parsed)
skip? (#'mu.fn/*skip-ns-decision-fn* *ns*)]
(if skip?
`(def ~(vary-meta fn-name merge attr-map)
~docstring
~(mu.fn/deparameterized-fn-form parsed))
`(def ~(vary-meta fn-name merge attr-map)
~docstring
~(macros/case
:clj (let [error-context {:fn-name (list 'quote fn-name)}]
(mu.fn/instrumented-fn-form error-context parsed))
:cljs (mu.fn/deparameterized-fn-form parsed)))))) |
This is exactly the same as [[malli.experimental.describe]], but handles our deferred i18n forms. | (ns metabase.util.malli.describe (:require [clojure.string :as str] [malli.core :as mc] [malli.experimental.describe :as med])) |
Given a schema, returns a string explaiaing the required shape in English | (defn describe
([?schema]
(describe ?schema nil))
([?schema options]
(let [options (merge options
{::mc/walk-entry-vals true
::med/definitions (atom {})
::med/describe med/-describe})]
(str/trim (str (med/-describe ?schema options)))))) |
This is a fix for upstream issue https://github.com/metosin/malli/issues/924 (the generated descriptions for
| |
#?(:clj
(defn- -length-suffix [schema]
(let [{:keys [min max]} (-> schema mc/properties)]
(cond
(and min max) (str " with length between " min " and " max " inclusive")
min (str " with length >= " min)
max (str " with length <= " max)
:else )))) | |
#?(:clj (alter-var-root #'med/-length-suffix (constantly -length-suffix))) | |
(ns metabase.util.malli.fn (:refer-clojure :exclude [fn]) (:require [clojure.core :as core] [malli.core :as mc] [malli.destructure :as md] [malli.error :as me] [metabase.config :as config] [metabase.shared.util.i18n :as i18n] [metabase.util.log :as log] [metabase.util.malli.humanize :as mu.humanize] [metabase.util.malli.registry :as mr])) | |
(set! *warn-on-reflection* true) | |
Malli normally generates wacky default schemas when you use destructuring in an argslist; this never seems to work correctly, so just add default schemas manually to circumvent Malli's weird behavior. (add-default-schemas '[x {:keys [y]}]) ;; => [x {:keys [y]} :- [:maybe :map]] | (defn- add-default-schemas
[args]
(if (empty? args)
args
(loop [acc [], [x & [y z :as more]] args]
(let [schema (when (= y :-) z)
more (if schema
(drop 2 more)
more)
schema (cond
schema
schema
(and (or (map? x)
(sequential? x))
(= (last acc) '&))
[:* :any]
(map? x)
[:maybe :map]
(sequential? x)
[:maybe [:sequential :any]])
acc (concat acc (if schema
[x :- schema]
[x]))]
(if (seq more)
(recur acc more)
acc))))) |
Given a | (defn- arity-schema
[{:keys [args], :as _arity} return-schema]
[:=>
(:schema (md/parse (add-default-schemas args)))
return-schema]) |
This is exactly the same as [[malli.experimental/SchematizedParams]], but it preserves metadata from the arglists. | (def ^:private SchematizedParams
(mc/schema
[:schema
{:registry {"Schema" any?
"Separator" [:= :-]
"Args" vector? ; [:vector :any] loses metadata, but vector? keeps it :shrug:
"PrePost" [:map
[:pre {:optional true} [:sequential any?]]
[:post {:optional true} [:sequential any?]]]
"Arity" [:catn
[:args "Args"]
[:prepost [:? "PrePost"]]
[:body [:* :any]]]
"Params" [:catn
[:name symbol?]
[:return [:? [:catn
[:- "Separator"]
[:schema "Schema"]]]]
[:doc [:? string?]]
[:meta [:? :map]]
[:arities [:altn
[:single "Arity"]
[:multiple [:catn
[:arities [:+ [:schema "Arity"]]]
[:meta [:? :map]]]]]]]}}
"Params"])) |
(def ^:private ^{:arglists '([fn-tail])} parse-SchematizedParams
(mc/parser SchematizedParams)) | |
Parse a parameterized | (defn parse-fn-tail
[fn-tail]
(let [parsed (parse-SchematizedParams (if (symbol? (first fn-tail))
fn-tail
(cons '&f fn-tail)))]
(when (= parsed ::mc/invalid)
(let [error (mc/explain SchematizedParams fn-tail)
humanized (mu.humanize/humanize error)]
(throw (ex-info (format "Invalid function tail: %s" humanized)
{:fn-tail fn-tail
:error error
:humanized humanized}))))
parsed)) |
Implementation for [[fn]] and [[metabase.util.malli.defn/defn]]. Given an unparsed parametered fn tail, extract the
annotations and return a | (defn fn-schema
[parsed]
(let [{:keys [return arities]} parsed
return-schema (:schema return :any)
[arities-type arities-value] arities]
(case arities-type
:single (arity-schema arities-value return-schema)
:multiple (into [:function]
(for [arity (:arities arities-value)]
(arity-schema arity return-schema)))))) |
(defn- deparameterized-arity [{:keys [body args prepost], :as _arity}]
(concat
[(:arglist (md/parse args))]
(when prepost
[prepost])
body)) | |
Generate a deparameterized | (defn deparameterized-fn-tail
[{[arities-type arities-value] :arities, :as _parsed}]
(let [body (case arities-type
:single (deparameterized-arity arities-value)
:multiple (for [arity (:arities arities-value)]
(deparameterized-arity arity)))]
body)) |
Impl for [[metabase.util.malli.fn/fn]] and [[metabase.util.malli.defn/defn]]. Given a parsed (deparameterized-fn-form (parse-fn-tail '[:- :int [x :- :int] (inc x)])) ;; => (fn [x] (inc x)) | (defn deparameterized-fn-form [parsed] `(core/fn ~@(deparameterized-fn-tail parsed))) |
Whether [[validate-input]] and [[validate-output]] should validate things or not. In Cljc code, you can use [[metabase.util.malli/disable-enforcement]] to bind this only in Clojure code. | (def ^:dynamic *enforce* true) |
(defn- validate [error-context schema value error-type]
(when *enforce*
(when-let [error (mr/explain schema value)]
(let [humanized (me/humanize error)
details (merge
{:type error-type
:error error
:humanized humanized
:schema schema
:value value}
error-context)]
(if (or config/is-dev?
config/is-test?)
;; In dev and test, throw an exception.
(throw (ex-info (case error-type
::invalid-input (i18n/tru "Invalid input: {0}" (pr-str humanized))
::invalid-output (i18n/tru "Invalid output: {0}" (pr-str humanized)))
details))
;; In prod, log a warning.
(log/warn
(case error-type
::invalid-input (i18n/tru "Invalid input - Please report this as an issue on Github: {0}"
(pr-str humanized))
::invalid-output (i18n/tru "Invalid output - Please report this as an issue on Github: {0}"
(pr-str humanized)))
details)))))) | |
Impl for [[metabase.util.malli.fn/fn]]; validates an input argument with | (defn validate-input [error-context schema value] (validate error-context schema value ::invalid-input)) |
Impl for [[metabase.util.malli.fn/fn]]; validates function output | (defn validate-output [error-context schema value] (validate error-context schema value ::invalid-output) value) |
(defn- varargs-schema? [[_cat & args :as _input-schema]]
(letfn [(star-schema? [schema]
(and (sequential? schema)
(= (first schema) :*)))]
(star-schema? (last args)))) | |
(defn- input-schema-arg-names [[_cat & args :as input-schema]]
(let [varargs? (varargs-schema? input-schema)
normal-args (if varargs?
(butlast args)
args)]
(concat
(for [n (range (count normal-args))]
(symbol (str (char (+ (int \a) n)))))
(when varargs?
['more])))) | |
(defn- input-schema->arglist [input-schema]
(let [arg-names (input-schema-arg-names input-schema)]
(vec (if (varargs-schema? input-schema)
(concat (butlast arg-names) ['& (last arg-names)])
arg-names)))) | |
(defn- input-schema->validation-forms [error-context [_cat & schemas :as input-schema]]
(let [arg-names (input-schema-arg-names input-schema)
schemas (if (varargs-schema? input-schema)
(concat (butlast schemas) [[:maybe (last schemas)]])
schemas)]
(->> (map (core/fn [arg-name schema]
;; 1. Skip checks against `:any` schema, there is no situation where it would fail.
;;
;; 2. Skip checks against the default varargs schema, there is no situation where [:maybe [:* :any]] is
;; going to fail.
(when-not (= schema (if (= arg-name 'more)
[:maybe [:* :any]]
:any))
`(validate-input ~error-context ~schema ~arg-name)))
arg-names
schemas)
(filter some?)))) | |
(defn- input-schema->application-form [input-schema]
(let [arg-names (input-schema-arg-names input-schema)]
(if (varargs-schema? input-schema)
(list* `apply '&f arg-names)
(list* '&f arg-names)))) | |
If exception is thrown from the [[validate]] machinery, remove those stack trace elements so the top of the stack is the calling function. | (defn fixup-stacktrace
[^Exception e]
(if (#{::invalid-input ::invalid-output} (-> e ex-data :type))
(let [trace (.getStackTrace e)
cleaned (when trace
(into-array StackTraceElement
(drop-while (comp #{(.getName (class validate))
(.getName (class validate-input))
(.getName (class validate-output))}
#(.getClassName ^StackTraceElement %))
trace)))]
(doto e
(.setStackTrace cleaned)))
e)) |
(defn- instrumented-arity [error-context [_=> input-schema output-schema]]
(let [input-schema (if (= input-schema :cat)
[:cat]
input-schema)
arglist (input-schema->arglist input-schema)
input-validation-forms (input-schema->validation-forms error-context input-schema)
result-form (input-schema->application-form input-schema)
result-form (if (and output-schema
(not= output-schema :any))
`(->> ~result-form
(validate-output ~error-context ~output-schema))
result-form)]
`(~arglist
(try
~@input-validation-forms
~result-form
(catch Exception ~'error
(throw (fixup-stacktrace ~'error))))))) | |
(defn- instrumented-fn-tail [error-context [schema-type :as schema]]
(case schema-type
:=>
[(instrumented-arity error-context schema)]
:function
(let [[_function & schemas] schema]
(for [schema schemas]
(instrumented-arity error-context schema))))) | |
Given a ([x :- :int y] (+ 1 2)) and parsed by [[parsed-fn-tail]], return an unevaluated instrumented [[fn]] form like (mc/-instrument {:schema [:=> [:cat :int :any] :any]} (fn [x y] (+ 1 2))) | (defn instrumented-fn-form
[error-context parsed]
`(let [~'&f ~(deparameterized-fn-form parsed)]
(core/fn ~@(instrumented-fn-tail error-context (fn-schema parsed))))) |
------------------------------ Skipping Namespace Enforcement in prod ------------------------------ | |
Used to track namespaces to not enforce malli schemas on with | (defn instrument-ns?
[namespace]
(let [lib-and-middleware [#"^metabase\.lib\..*"
#"^metabase\.query-processor\.middleware\..*"]
matches? (core/fn [namespace regexes]
(let [n (-> namespace ns-name str)]
(some #(re-matches % n) regexes)))
;; empty but placeholder for any namespaces we want to never instrument (in prod)
ad-hoc #{}
m (meta namespace)]
(cond (:instrument/always m) true
(:instrument/never m) false
(matches? namespace lib-and-middleware) false
(contains? ad-hoc (ns-name namespace)) false
:else true))) |
Returns true to skip the emission of malli schema validation code in mu.fn/fn and mu/defn. | (def ^:private ^:dynamic *skip-ns-decision-fn*
(core/fn skip-ns-decision-fn
[namespace]
(and config/is-prod?
(let [instrument? (instrument-ns? namespace)]
(when-not instrument?
(log/info "skipping instrumentation of var in " (ns-name namespace)))
(not instrument?))))) |
Malli version of [[schema.core/fn]]. Unless it's in a skipped namespace during prod, a form like: (fn :- :int [x :- :int] (inc x)) compiles to something like (let [&f (fn [x] (inc x))] (fn [a] (validate-input {} :int a) (validate-output {} :int (&f a)))) The map arg here is additional error context; for something like [[metabase.util.malli/defn]], it will be something like {:fn-name 'metabase.lib.field/resolve-field-id} for [[metabase.util.malli/defmethod]] it will be something like {:fn-name 'whatever/my-multimethod, :dispatch-value :field} If compiled in a namespace in [[namespaces-toskip]], during Known issue: this version of (mu/fn my-fn ([x] (my-fn x 1)) ([x y :- :int] (+ x y))) If we were to include (let [&f (fn my-fn ([x] (my-fn x 1)) ([x y] (+ x y)))] (fn ([a] (&f a)) ([a b] (validate-input {} :int b) (&f a b)))) ;; skips the Since this is a big gotcha, we are currently not including the optional function name | (defmacro fn
[& fn-tail]
(let [parsed (parse-fn-tail fn-tail)
skip? (*skip-ns-decision-fn* *ns*)]
(if skip?
(deparameterized-fn-form parsed)
(let [error-context (if (symbol? (first fn-tail))
;; We want the quoted symbol of first fn-tail:
{:fn-name (list 'quote (first fn-tail))} {})]
(instrumented-fn-form error-context parsed))))) |
(ns metabase.util.malli.humanize (:require [malli.error :as me])) | |
This is the same behavior as what [[malli.error/humanize]] does to resolve errors. | (defn- resolve-error
[explanation error]
(me/-resolve-direct-error explanation error {:wrap :message, :resolve me/-resolve-direct-error})) |
Given a [[2] "some error"] return a flattened error message like [nil nil "some error"] | (defn- flatten-error
[[path message]]
(if (empty? path)
message
(recur
[(butlast path)
(if (integer? (last path))
(me/-push [] (last path) message nil)
{(last path) message})]))) |
Merge two flattened errors into a single error, e.g. (merge-errors {:x "oops"} {:x "oh no"}) ;; => {:x ("oops" "oh no")} List-like structures are used to differentiate multiple errors (e.g., the result of an | (defn- merge-errors
[msg-1 msg-2]
(cond
(= msg-1 msg-2)
msg-1
(nil? msg-1)
msg-2
(seq? msg-1)
(distinct (concat msg-1 (if (seq? msg-2) msg-2 [msg-2])))
(and (map? msg-1)
(map? msg-2))
(merge-with merge-errors msg-1 msg-2)
(and (vector? msg-1)
(vector? msg-2)
(= (count msg-1) (count msg-2)))
(mapv merge-errors msg-1 msg-2)
:else
(distinct (list msg-1 msg-2)))) |
Improved version of [[malli.error/humanize]]. This is mostly similar to vanilla [[malli.error/humanize]], but
combines 'resolved' errors in a different way that avoids discarding errors in | (defn humanize
[{:keys [errors], :as explanation}]
(transduce
(comp (map (fn [error]
(resolve-error explanation error)))
(map flatten-error))
(completing merge-errors)
nil
errors)) |
TODO: Consider refacor this namespace by defining custom schema with [[mr/def]] instead. For example the PositiveInt can be defined as (mr/def ::positive-int pos-int?) | (ns metabase.util.malli.schema (:require [cheshire.core :as json] [malli.core :as mc] [metabase.lib.schema.common :as lib.schema.common] [metabase.mbql.normalize :as mbql.normalize] [metabase.mbql.schema :as mbql.s] [metabase.models.dispatch :as models.dispatch] [metabase.util :as u] [metabase.util.date-2 :as u.date] [metabase.util.i18n :as i18n :refer [deferred-tru]] [metabase.util.malli :as mu] [metabase.util.password :as u.password])) |
(set! *warn-on-reflection* true) | |
-------------------------------------------------- Utils -------------------------------------------------- | |
Helper for creating a schema to check whether something is an instance of (ms/defn my-fn [user :- (ms/InstanceOf User)] ...) TODO -- consider renaming this to | (defn InstanceOf
[model]
(mu/with-api-error-message
[:fn
{:error/message (format "value must be an instance of %s" (name model))}
#(models.dispatch/instance-of? model %)]
(deferred-tru "value must be an instance of {0}" (name model)))) |
Helper for creating schemas to check whether something is an instance of a given class. | (defn InstanceOfClass
[^Class klass]
[:fn
{:error/message (format "Instance of a %s" (.getCanonicalName klass))}
(partial instance? klass)]) |
Given a schema of a sequence of maps, returns a schema that does an additional unique check on key | (defn maps-with-unique-key
[maps-schema k]
(mu/with-api-error-message
[:and
[:fn (fn [maps]
(= (count maps)
(-> (map #(get % k) maps)
distinct
count)))]
maps-schema]
(deferred-tru "value must be seq of maps in which {0}s are unique" (name k)))) |
-------------------------------------------------- Schemas -------------------------------------------------- | |
Schema for a string that cannot be blank. TODO -- this does not actually ensure that the string cannot be BLANK at all! | (def NonBlankString (mu/with-api-error-message ::lib.schema.common/non-blank-string (deferred-tru "value must be a non-blank string."))) |
Schema representing an integer than must also be greater than or equal to zero. | (def IntGreaterThanOrEqualToZero
(mu/with-api-error-message
[:int {:min 0}]
;; FIXME: greater than _or equal to_ zero.
(deferred-tru "value must be an integer greater than zero."))) |
Schema representing an integer. | (def Int
(mu/with-api-error-message
int?
(deferred-tru "value must be an integer."))) |
Schema representing an integer than must also be greater than zero. | (def PositiveInt
(mu/with-api-error-message
pos-int?
(deferred-tru "value must be an integer greater than zero."))) |
Schema representing an integer than must be less than zero. | (def NegativeInt
(mu/with-api-error-message
neg?
(deferred-tru "value must be a negative integer"))) |
Schema representing a numeric value greater than zero. This allows floating point numbers and integers. | (def PositiveNum
(mu/with-api-error-message
[:and number? pos?]
(deferred-tru "value must be a number greater than zero."))) |
Schema for something that can be either a | (def KeywordOrString
(mu/with-api-error-message
[:or :string :keyword]
(deferred-tru "value must be a keyword or string."))) |
Schema for a valid Field base or effective (data) type (does it derive from | (def FieldType
(mu/with-api-error-message
[:fn #(isa? % :type/*)]
(deferred-tru "value must be a valid field type."))) |
Schema for a valid Field semantic type deriving from | (def FieldSemanticType
(mu/with-api-error-message
[:fn #(isa? % :Semantic/*)]
(deferred-tru "value must be a valid field semantic type."))) |
Schema for a valid Field relation type deriving from | (def FieldRelationType
(mu/with-api-error-message
[:fn #(isa? % :Relation/*)]
(deferred-tru "value must be a valid field relation type."))) |
Schema for a valid Field semantic or Relation type. This is currently needed because the | (def FieldSemanticOrRelationType
(mu/with-api-error-message
[:fn (fn [k] (or (isa? k :Semantic/*) (isa? k :Relation/*)))]
(deferred-tru "value must be a valid field semantic or relation type."))) |
Schema for a valid Field coercion strategy (does it derive from | (def CoercionStrategy
(mu/with-api-error-message
[:fn #(isa? % :Coercion/*)]
(deferred-tru "value must be a valid coercion strategy."))) |
Like | (def FieldTypeKeywordOrString
(mu/with-api-error-message
[:fn #(isa? (keyword %) :type/*)]
(deferred-tru "value must be a valid field data type (keyword or string)."))) |
Like | (def FieldSemanticTypeKeywordOrString
(mu/with-api-error-message
[:fn #(isa? (keyword %) :Semantic/*)]
(deferred-tru "value must be a valid field semantic type (keyword or string)."))) |
Like | (def FieldRelationTypeKeywordOrString
(mu/with-api-error-message
[:fn #(isa? (keyword %) :Relation/*)]
(deferred-tru "value must be a valid field relation type (keyword or string)."))) |
Like | (def FieldSemanticOrRelationTypeKeywordOrString
(mu/with-api-error-message
[:fn (fn [k]
(let [k (keyword k)]
(or (isa? k :Semantic/*)
(isa? k :Relation/*))))]
(deferred-tru "value must be a valid field semantic or relation type (keyword or string)."))) |
Schema for a valid Field for API usage. | (def Field
(mu/with-api-error-message
[:fn (fn [k]
((comp (mc/validator mbql.s/Field)
mbql.normalize/normalize-tokens) k))]
(deferred-tru "value must an array with :field id-or-name and an options map"))) |
Like | (def CoercionStrategyKeywordOrString
(mu/with-api-error-message
[:fn #(isa? (keyword %) :Coercion/*)]
(deferred-tru "value must be a valid coercion strategy (keyword or string)."))) |
Validates entity type derivatives of | (def EntityTypeKeywordOrString
(mu/with-api-error-message
[:fn #(isa? (keyword %) :entity/*)]
(deferred-tru "value must be a valid entity type (keyword or string)."))) |
Schema for a valid map. | (def Map
(mu/with-api-error-message
:map
(deferred-tru "Value must be a map."))) |
Schema for a valid email string. | (def Email
(mu/with-api-error-message
[:and
:string
[:fn u/email?]]
(deferred-tru "value must be a valid email address."))) |
Schema for a valid password of sufficient complexity which is not found on a common password list. | (def ValidPassword
(mu/with-api-error-message
[:and
:string
[:fn (every-pred string? #'u.password/is-valid?)]]
(deferred-tru "password is too common."))) |
Schema for a string that can be parsed as an integer.
Something that adheres to this schema is guaranteed to to work with | (def IntString
(mu/with-api-error-message
[:and
:string
[:fn #(u/ignore-exceptions (Integer/parseInt %))]]
(deferred-tru "value must be a valid integer."))) |
Schema for a string that can be parsed as an integer, and is greater than zero.
Something that adheres to this schema is guaranteed to to work with | (def IntStringGreaterThanZero
(mu/with-api-error-message
[:and
:string
[:fn #(u/ignore-exceptions (< 0 (Integer/parseInt %)))]]
(deferred-tru "value must be a valid integer greater than zero."))) |
Schema for a string that can be parsed as an integer, and is greater than or equal to zero.
Something that adheres to this schema is guaranteed to to work with | (def IntStringGreaterThanOrEqualToZero
(mu/with-api-error-message
[:and
:string
[:fn #(u/ignore-exceptions (<= 0 (Integer/parseInt %)))]]
(deferred-tru "value must be a valid integer greater than or equal to zero."))) |
Schema for a string that is a valid representation of a boolean (either | (def BooleanString
(mu/with-api-error-message
[:enum "true" "false" "TRUE" "FALSE"]
(deferred-tru "value must be a valid boolean string (''true'' or ''false'')."))) |
Schema for a string that can be parsed by date2/parse. | (def TemporalString
(mu/with-api-error-message
[:and
:string
[:fn #(u/ignore-exceptions (boolean (u.date/parse %)))]]
(deferred-tru "value must be a valid date string"))) |
Schema for a string that is valid serialized JSON. | (def JSONString
(mu/with-api-error-message
[:and
:string
[:fn #(try
(json/parse-string %)
true
(catch Throwable _
false))]]
(deferred-tru "value must be a valid JSON string."))) |
(def ^:private keyword-or-non-blank-str-malli
(mc/schema
[:or :keyword NonBlankString])) | |
Schema for a valid representation of a boolean
(one of | (def BooleanValue
(-> [:enum {:decode/json (fn [b] (contains? #{"true" true} b))}
"true" "false" true false]
(mu/with-api-error-message
(deferred-tru "value must be a valid boolean string (''true'' or ''false'').")))) |
Schema for valid source_options within a Parameter | (def ValuesSourceConfig
;; TODO: This should be tighter
(mc/schema
[:map
[:values {:optional true} [:* :any]]
[:card_id {:optional true} PositiveInt]
[:value_field {:optional true} Field]
[:label_field {:optional true} Field]])) |
Has two components:
1. | (def RemappedFieldValue [:tuple :any :string]) |
Has one component: | (def NonRemappedFieldValue [:tuple :any]) |
Schema for a valid list of values for a field, in contexts where the field can have a remapped field. | (def FieldValuesList [:or [:sequential RemappedFieldValue] [:sequential NonRemappedFieldValue]]) |
Schema for a value result of fetching the values for a field, in contexts where the field can have a remapped field. | (def FieldValuesResult [:map [:has_more_values :boolean] [:values FieldValuesList]]) |
Schema for a valid Parameter. We're not using [metabase.mbql.schema/Parameter] here because this Parameter is meant to be used for Parameters we store on dashboard/card, and it has some difference with Parameter in MBQL. | #_(def ParameterSource
(mc/schema
[:multi {:dispatch :values_source_type}
["card" [:map
[:values_source_type :string]
[:values_source_config
[:map {:closed true}
[:card_id {:optional true} IntGreaterThanZero]
[:value_field {:optional true} Field]
[:label_field {:optional true} Field]]]]]
["static-list" [:map
[:values_source_type :string]
[:values_source_config
[:map {:closed true}
[:values {:optional true} [:* :any]]]]]]]))
(def Parameter
;; TODO we could use :multi to dispatch values_source_type to the correct values_source_config
(mu/with-api-error-message
[:map [:id NonBlankString]
[:type keyword-or-non-blank-str-malli]
;; TODO how to merge this with ParameterSource above?
[:values_source_type {:optional true} [:enum "static-list" "card" nil]]
[:values_source_config {:optional true} ValuesSourceConfig]
[:slug {:optional true} :string]
[:name {:optional true} :string]
[:default {:optional true} :any]
[:sectionId {:optional true} NonBlankString]]
(deferred-tru "parameter must be a map with :id and :type keys"))) |
Schema for a valid Parameter Mapping | (def ParameterMapping
(mu/with-api-error-message
[:map [:parameter_id NonBlankString]
[:target :any]
[:card_id {:optional true} PositiveInt]]
(deferred-tru "parameter_mapping must be a map with :parameter_id and :target keys"))) |
Schema for a valid map of embedding params. | (def EmbeddingParams
(mu/with-api-error-message
[:maybe [:map-of
:keyword
[:enum "disabled" "enabled" "locked"]]]
(deferred-tru "value must be a valid embedding params map."))) |
Schema for a valid ISO Locale code e.g. | (def ValidLocale
(mu/with-api-error-message
[:and
NonBlankString
[:fn i18n/available-locale?]]
(deferred-tru "String must be a valid two-letter ISO language or language-country code e.g. 'en' or 'en_US'."))) |
Schema for a 21-character NanoID string, like "FReCLx5hSWTBU7kjCWfuu". | (def NanoIdString
(mu/with-api-error-message
[:re #"^[A-Za-z0-9_\-]{21}$"]
(deferred-tru "String must be a valid 21-character NanoID string."))) |
Schema for a UUID string | (def UUIDString (mu/with-api-error-message [:re u/uuid-regex] (deferred-tru "value must be a valid UUID."))) |
(ns metabase.util.memoize (:require [clojure.core.memoize :as memoize] [metabase.shared.util.namespaces :as shared.ns])) | |
(comment memoize/keep-me) | |
(shared.ns/import-fns [memoize lru memoizer]) | |
Copied from clojure.core.memoize. | (ns metabase.util.memoize (:require [cljs.cache :as cache])) |
Similar to clojure.lang.Delay, but will not memoize an exception and will instead retry. fun - the function, never nil available? - indicates a memoized value is available, volatile for visibility value - the value (if available) - volatile for visibility | (deftype RetryingDelay [fun ^:volatile-mutable available? ^:volatile-mutable value]
IDeref
(-deref [_]
;; first check (safe with volatile flag)
(if available?
value
;; fun may throw - will retry on next deref
(let [v (fun)]
(set! value v)
(set! available? true)
v)))
IPending
(-realized? [_]
available?)) |
(defn- d-lay [fun] (->RetryingDelay fun false nil)) | |
If a value is not already derefable, wrap it up. This is used to help rebuild seed/base maps passed in to the various caches so that they conform to core.memoize's world view. | (defn- make-derefable
[v]
(if (instance? IDeref v)
v
(reify IDeref
(-deref [_] v)))) |
Given a seed/base map, ensure all the values in it are derefable. | (defn- derefable-seed [seed] (update-vals seed make-derefable)) |
(deftype PluggableMemoization [f cache]
cache/CacheProtocol
(has? [_ item]
(cache/has? cache item))
(hit [_ item]
(PluggableMemoization. f (cache/hit cache item)))
(miss [_ item result]
(PluggableMemoization. f (cache/miss cache item result)))
(evict [_ key]
(PluggableMemoization. f (cache/evict cache key)))
(lookup [_ item]
(cache/lookup cache item nil))
(lookup [_ item not-found]
(cache/lookup cache item (delay not-found)))
(seed [_ base]
(PluggableMemoization.
f (cache/seed cache (derefable-seed base))))
Object
(toString [_] (str cache))) | |
Returns a function's argument transformer. | (def ^{:private true
:doc }
args-fn #(or (::args-fn (meta %)) identity)) |
The basic hit/miss logic for the cache system based on | (defn- through* [cache f args item] (cache/through (fn [f _] (d-lay #(f args))) #(apply f %) cache item)) |
Given a function, an atom containing a (pluggable memoization cache), and and cache key function, return a new function that behaves like the original function except it is cached, based on its arguments. | (defn- cached-function
[f cache-atom ckey-fn]
(fn [& args]
(let [ckey (or (ckey-fn args) [])
cs (swap! cache-atom through* f args ckey)
val (cache/lookup cs ckey ::not-found)]
;; If `lookup` returns `(delay ::not-found)`, it's likely that
;; we ran into a timing issue where eviction and access
;; are happening at about the same time. Therefore, we retry
;; the `swap!` (potentially several times).
;;
;; metabase.util.memoize currently wraps all of its values in a `delay`.
(when val
(loop [n 0 v @val]
(if (= ::not-found v)
(when-let [v' (cache/lookup
(swap! cache-atom through* f args ckey)
ckey ::not-found)]
(when (< n 10)
(recur (inc n) @v')))
v)))))) |
Build a pluggable memoized version of a function. Given a function and a (pluggable memoized) cache, and an optional seed (hash map of arguments to return values), return a cached version of that function. If you want to build your own cached function, perhaps with combined caches or customized caches, this is the preferred way to do so now. | (defn memoizer
([f cache]
(let [cache (atom (PluggableMemoization. f cache))
ckey-fn (args-fn f)]
(cached-function f cache ckey-fn)))
([f cache seed]
(let [cache (atom (cache/seed (PluggableMemoization. f cache)
(derefable-seed seed)))
ckey-fn (args-fn f)]
(cached-function f cache ckey-fn)))) |
Works the same as the basic memoization function (i.e.
| (defn lru
([f] (lru f {} :lru/threshold 32))
([f base] (lru f base :lru/threshold 32))
([f tkey threshold] (lru f {} tkey threshold))
([f base key threshold]
(assert (= key :lru/threshold) (str "wrong parameter key " key))
(memoizer f (cache/lru-cache-factory {} :threshold threshold) base))) |
(ns metabase.util.methodical.null-cache (:require [methodical.interface]) (:import (methodical.interface Cache))) | |
(set! *warn-on-reflection* true) | |
(comment methodical.interface/keep-me) | |
(declare null-cache) | |
(deftype ^:private NullCache [] Cache (cached-method [_cache _dispatch-value] nil) (cache-method! [_cache _dispatch-value _method] nil) (clear-cache! [_cache] nil) (empty-copy [_cache] (null-cache))) | |
A cache implementation that doesn't actually cache anything. To work around upstream bug https://github.com/camsaul/methodical/issues/98 | (defn null-cache [] (->NullCache)) |
Workaround for upstream issue https://github.com/camsaul/methodical/issues/97 Actually a bit of a misnomer since this does still sort dispatch values; it just doesn't complain if any are ambiguous. | (ns metabase.util.methodical.unsorted-dispatcher (:require [methodical.impl.dispatcher.standard] [methodical.interface]) (:import (methodical.interface Dispatcher))) |
(set! *warn-on-reflection* true) | |
(comment methodical.interface/keep-me) | |
(deftype UnsortedDispatcher [dispatch-fn hierarchy-var default-value]
Dispatcher
(dispatch-value [_] (dispatch-fn))
(dispatch-value [_ a] (dispatch-fn a))
(dispatch-value [_ a b] (dispatch-fn a b))
(dispatch-value [_ a b c] (dispatch-fn a b c))
(dispatch-value [_ a b c d] (dispatch-fn a b c d))
(dispatch-value [_ a b c d more] (apply dispatch-fn a b c d more))
(matching-primary-methods [_this method-table dispatch-value]
(methodical.impl.dispatcher.standard/matching-primary-methods
{:hierarchy (deref hierarchy-var)
:default-value default-value
:method-table method-table
:dispatch-value dispatch-value
:ambiguous-fn (constantly false)}))
(matching-aux-methods [_this method-table dispatch-value]
(methodical.impl.dispatcher.standard/matching-aux-methods
{:hierarchy (deref hierarchy-var)
:default-value default-value
:method-table method-table
:dispatch-value dispatch-value
:ambiguous-fn (constantly false)}))
(default-dispatch-value [_this]
default-value)
(prefers [_]
nil)
(with-prefers [this new-prefs]
(when (seq new-prefs)
(throw (UnsupportedOperationException. (format "%s does not support preferences." `unsupported-dispatcher))))
this)
(dominates? [_this _x _y]
false)) | |
This is basically similar the same as the [[methodical.core/standard-dispatcher]], but doesn't complain when dispatch values are ambiguous, and doesn't support preferences. | (defn unsorted-dispatcher
[dispatch-fn & {:keys [hierarchy default-value]
:or {hierarchy #'clojure.core/global-hierarchy
default-value :default}}]
{:pre [(ifn? dispatch-fn) (instance? clojure.lang.IDeref hierarchy)]}
(->UnsortedDispatcher dispatch-fn hierarchy default-value)) |
Utility functions for checking passwords against hashes and for making sure passwords match complexity requirements. | (ns metabase.util.password (:require [clojure.java.io :as io] [metabase.config :as config] [metabase.util :as u]) (:import (org.mindrot.jbcrypt BCrypt))) |
(set! *warn-on-reflection* true) | |
Return a map of the counts of each class of character for (count-occurrences "GoodPw!!") -> {:total 8, :lower 4, :upper 2, :letter 6, :digit 0, :special 2} | (defn- count-occurrences
[password]
(loop [[^Character c & more] password, counts {:total 0, :lower 0, :upper 0, :letter 0, :digit 0, :special 0}]
(if-not c
counts
(recur more (let [counts (update counts :total inc)]
(cond
(Character/isLowerCase c) (-> (update counts :letter inc) (update :lower inc))
(Character/isUpperCase c) (-> (update counts :letter inc) (update :upper inc))
(Character/isDigit c) (update counts :digit inc)
:else (update counts :special inc))))))) |
Minimum counts of each class of character a password should have for a given password complexity level. | (def ^:private ^:const complexity->char-type->min
{:weak {:total 6} ; total here effectively means the same thing as a minimum password length
:normal {:total 6
:digit 1}
:strong {:total 8
:lower 2
:upper 2
:digit 1
:special 1}}) |
Check that PASSWORD satisfies the minimum count requirements for each character class. (password-has-char-counts? {:total 6, :lower 1, :upper 1, :digit 1, :special 1} "abc") -> false (password-has-char-counts? {:total 6, :lower 1, :upper 1, :digit 1, :special 1} "passworD1!") -> true | (defn- password-has-char-counts?
[char-type->min password]
{:pre [(map? char-type->min)
(string? password)]}
(let [occurences (count-occurrences password)]
(boolean (loop [[[char-type min-count] & more] (seq char-type->min)]
(if-not char-type true
(when (>= (occurences char-type) min-count)
(recur more))))))) |
The currently configured description of the password complexity rules being enforced | (defn active-password-complexity
[]
(merge (complexity->char-type->min (config/config-kw :mb-password-complexity))
;; Setting MB_PASSWORD_LENGTH overrides the default :total for a given password complexity class
(when-let [min-len (config/config-int :mb-password-length)]
{:total min-len}))) |
Check if a given password meets complexity standards for the application. | (defn- is-complex? [password] (password-has-char-counts? (active-password-complexity) password)) |
A set of ~12k common passwords to reject, that otherwise meet Metabase's default complexity requirements. Sourced from Dropbox's zxcvbn repo: https://github.com/dropbox/zxcvbn/blob/master/data/passwords.txt | (def ^java.net.URL common-passwords-url (io/resource "common_passwords.txt")) |
Check if a given password is not present in the common passwords set. Case-insensitive search since the list only contains lower-case passwords. | (defn- is-uncommon?
[password]
(with-open [is (.openStream common-passwords-url)
reader (java.io.BufferedReader. (java.io.InputStreamReader. is))]
(not-any?
(partial = (u/lower-case-en password))
(iterator-seq (.. reader lines iterator))))) |
Check that a password both meets complexity standards, and is not present in the common passwords list. Common password list is ignored if minimum password complexity is set to :weak | (defn is-valid?
[password]
(and (is-complex? password)
(or (= (config/config-kw :mb-password-complexity) :weak)
(is-uncommon? password)))) |
Hashes a given plaintext password using bcrypt and an optional
:work-factor (defaults to 10 as of this writing). Should be used to hash
passwords included in stored user credentials that are to be later verified
using copied from cemerick.friend.credentials EPL v1.0 license | (defn hash-bcrypt
[password & {:keys [work-factor]}]
(BCrypt/hashpw password (if work-factor
(BCrypt/gensalt work-factor)
(BCrypt/gensalt)))) |
Returns true if the plaintext [password] corresponds to [hash], the result of previously hashing that password. | (defn bcrypt-verify [password hash] (BCrypt/checkpw password hash)) |
Verify if a given unhashed password + salt matches the supplied hashed-password. Returns | (defn verify-password
^Boolean [password salt hashed-password]
;; we wrap the friend/bcrypt-verify with this function specifically to avoid unintended exceptions getting out
(boolean (u/ignore-exceptions
(bcrypt-verify (str salt password) hashed-password)))) |
(ns metabase.util.random
(:require
[clojure.string :as str]
[metabase.util :as u])) | |
(defn- random-uppercase-letter [] (char (+ (int \A) (rand-int 26)))) | |
Generate a random string of 20 uppercase letters. | (defn random-name [] (str/join (repeatedly 20 random-uppercase-letter))) |
Generate a random hash of 44 characters to simulate a base64 encoded sha. Eg, "y6dkn65bbhRZkXj9Yyp0awCKi3iy/xeVIGa/eFfsszM=" | (defn random-hash
[]
(let [chars (concat (map char (range (int \a) (+ (int \a) 25)))
(map char (range (int \A) (+ (int \A) 25)))
(range 10)
[\/ \+])]
(str (apply str (repeatedly 43 #(rand-nth chars))) "="))) |
Generate a random email address. | (defn random-email [] (str (u/lower-case-en (random-name)) "@metabase.com")) |
Regex-related utility functions | (ns metabase.util.regex (:require [clojure.string :as str])) |
Wrap regex | (defn non-capturing-group [pattern] (re-pattern (format "(?:%s)" pattern))) |
Combine regex | (defn re-or [patterns] (non-capturing-group (str/join "|" (map non-capturing-group patterns)))) |
Make regex | (defn re-optional [pattern] (str (non-capturing-group pattern) "?")) |
Make regex | (defn re-negate [pattern] (str "(?!" pattern ")")) |
(defmulti ^:private rx-dispatch
{:arglists '([listt])}
first) | |
(declare rx*) | |
(defmethod rx-dispatch :default [x] x) | |
(defmethod rx-dispatch :? [[_ & args]] (re-optional (rx* (into [:and] args)))) | |
(defmethod rx-dispatch :or [[_ & args]] (re-or (map rx* args))) | |
(defmethod rx-dispatch :and [[_ & args]] (apply str (map rx* args))) | |
(defmethod rx-dispatch :not [[_ arg]] (re-negate (rx* arg))) | |
(defn- rx* [x] (if (seqable? x) (rx-dispatch x) x)) | |
A quick-and-dirty port of the Emacs Lisp
TODO -- instead of memoizing this, why not just do this as a macro and do it at macroexpansion time? Weird. | (def ^{:doc
:arglists '([x] [x & more])
} rx
(memoize (fn rx
;; (rx [:and [:or "Cam" "can"] [:? #"\s+"] #"\d+"])
;; -> #\"(?:(?:Cam)|(?:can))(?:\s+)?\d+\"
([x] (re-pattern (rx* x)))
([x & more] (rx (into [:and x] more)))))) |
Support for in-memory, thread-blocking retrying. | (ns metabase.util.retry
(:require [metabase.models.setting :refer [defsetting]]
[metabase.util.i18n :refer [deferred-tru]])
(:import
(io.github.resilience4j.core IntervalFunction)
(io.github.resilience4j.retry Retry RetryConfig)
(java.util.function Predicate))) |
(set! *warn-on-reflection* true) | |
(defsetting retry-max-attempts (deferred-tru "The maximum number of attempts for an event.") :type :integer :default 7) | |
(defsetting retry-initial-interval (deferred-tru "The initial retry delay in milliseconds.") :type :integer :default 500) | |
(defsetting retry-multiplier (deferred-tru "The delay multiplier between attempts.") :type :double :default 2.0) | |
(defsetting retry-randomization-factor (deferred-tru "The randomization factor of the retry delay.") :type :double :default 0.1) | |
(defsetting retry-max-interval-millis (deferred-tru "The maximum delay between attempts.") :type :integer :default 30000) | |
(defn- retry-configuration []
{:max-attempts (retry-max-attempts)
:initial-interval-millis (retry-initial-interval)
:multiplier (retry-multiplier)
:randomization-factor (retry-randomization-factor)
:max-interval-millis (retry-max-interval-millis)}) | |
(defn- make-predicate [f] (reify Predicate (test [_ x] (f x)))) | |
Returns a randomized exponential backoff retry named | (defn random-exponential-backoff-retry
^Retry [^String retry-name
{:keys [^long max-attempts ^long initial-interval-millis
^double multiplier ^double randomization-factor
^long max-interval-millis
retry-on-result-pred retry-on-exception-pred]}]
(let [interval-fn (IntervalFunction/ofExponentialRandomBackoff
initial-interval-millis multiplier
randomization-factor max-interval-millis)
base-config (-> (RetryConfig/custom)
(.maxAttempts max-attempts)
(.intervalFunction interval-fn))
retry-config (cond-> base-config
retry-on-result-pred
(.retryOnResult (make-predicate retry-on-result-pred))
retry-on-exception-pred
(.retryOnException (make-predicate retry-on-exception-pred)))]
(Retry/of retry-name (.build retry-config)))) |
Returns a function accepting the same arguments as | (defn decorate
([f]
(decorate f (random-exponential-backoff-retry (str (random-uuid)) (retry-configuration))))
([f ^Retry retry]
(fn [& args]
(let [callable (reify Callable (call [_] (apply f args)))]
(.call (Retry/decorateCallable retry callable)))))) |
Various schemas that are useful throughout the app. Schemas defined are deprecated and should be replaced with Malli schema defined in [[metabase.util.malli.schema]]. If you update schemas in this ns, please make sure you update the malli schema too. It'll help us makes the transition easier. | (ns ^{:deprecated "0.46.0"}
metabase.util.schema
(:require
[clojure.string :as str]
[metabase.types :as types]
[metabase.util.i18n :as i18n :refer [deferred-tru]]
[schema.core :as s]
[schema.macros :as s.macros]
[schema.utils :as s.utils])) |
(set! *warn-on-reflection* true) | |
So the | (comment types/keep-me) |
always validate all schemas in s/defn function declarations. See https://github.com/plumatic/schema#schemas-in-practice for details. | (s/set-fn-validation! true) |
swap out the default impl of | (defn- schema-core-validator [schema]
(let [c (s/checker schema)]
(fn [value]
(when-let [error (c value)]
(s.macros/error! (s.utils/format* "Value does not match schema: %s" (pr-str error))
{:value value, :error error}))
value))) |
(alter-var-root #'s/validator (constantly schema-core-validator)) | |
+----------------------------------------------------------------------------------------------------------------+ | Plumatic API Schema Validation & Error Messages | +----------------------------------------------------------------------------------------------------------------+ | |
Return | (defn with-api-error-message
{:style/indent [:form]}
[schema api-error-message]
(if-not (record? schema)
;; since this only works for record types, if `schema` isn't already one just wrap it in `s/named` to make it one
(recur (s/named schema api-error-message) api-error-message)
(assoc schema :api-error-message api-error-message))) |
Add an addditonal constraint to | (defn non-empty
[schema]
(with-api-error-message (s/constrained schema seq "Non-empty")
(deferred-tru "The array cannot be empty."))) |
+----------------------------------------------------------------------------------------------------------------+ | USEFUL SCHEMAS | +----------------------------------------------------------------------------------------------------------------+ | |
Schema for a string that cannot be blank. | (def NonBlankString
(with-api-error-message (s/constrained s/Str (complement str/blank?) "Non-blank string")
(deferred-tru "value must be a non-blank string."))) |
Schema representing an integer than must also be greater than zero. TODO - rename this to | (def IntGreaterThanZero
(with-api-error-message
(s/constrained s/Int (partial < 0) (deferred-tru "Integer greater than zero"))
(deferred-tru "value must be an integer greater than zero."))) |
Schema for a valid map. | (def Map
(with-api-error-message (s/named clojure.lang.IPersistentMap (deferred-tru "Valid map"))
(deferred-tru "value must be a map."))) |
(ns metabase.util.secret (:require [metabase.util.i18n :refer [trs]]) (:import (java.io Writer))) | |
(set! *warn-on-reflection* true) | |
Define a protocol for secrets to make things harder to accidentally expose. | (defprotocol ISecret (expose [this] "Expose the secret")) |
(defrecord Secret [value-fn] ISecret (expose [_this] (value-fn)) Object (toString [_this] (trs "<< REDACTED SECRET >>"))) | |
(defmethod print-method Secret [^Secret secret ^Writer writer] (.write writer (.toString secret))) | |
(defmethod print-dup Secret [^Secret secret ^Writer w] (.write w (.toString secret))) | |
Create a | (defn secret [value] (->Secret (constantly value))) |
This is a map type that catches attempts to get This is here so we can catch driver code that needs to be updated in 48+ to use MLv2 metadata rather than Toucan instances. After 51 we can remove this, everything should be updated by then. | (ns metabase.util.snake-hating-map (:require [clojure.string :as str] [metabase.config :as config] [metabase.util :as u] [metabase.util.log :as log] [potemkin :as p] [pretty.core :as pretty])) |
(defn- snake-cased-key? [k] (some-> k (str/includes? "_"))) | |
(defn- warn-about-using-snake-case [k]
(let [e (ex-info (format "Accessing metadata using :snake_case key %s. This is deprecated in 0.48.0. Use %s instead."
(pr-str k)
(pr-str (u/->kebab-case-en k)))
{:k k})]
(if config/is-prod?
(log/warn e)
(throw e)))) | |
(defn- normalize-key [k]
(if (snake-cased-key? k)
(do
(warn-about-using-snake-case k)
(u/->kebab-case-en k))
k)) | |
(declare ->SnakeHatingMap) | |
(p/def-map-type SnakeHatingMap [m]
(get [_this k default-value]
(get m (normalize-key k) default-value))
(assoc [this k v]
(let [m' (assoc m (normalize-key k) v)]
(if (identical? m m')
this
(->SnakeHatingMap m'))))
(dissoc [this k]
(let [m' (dissoc m k)]
(if (identical? m m')
this
(->SnakeHatingMap m'))))
(keys [_this]
(keys m))
(meta [_this]
(meta m))
(with-meta [this metta]
(let [m' (with-meta m metta)]
(if (identical? m m')
this
(->SnakeHatingMap m'))))
pretty/PrettyPrintable
(pretty [_this]
(list `snake-hating-map m))) | |
Create a new map that handles either | (defn snake-hating-map
([]
(snake-hating-map {}))
([m]
(-> (or m {})
(vary-meta assoc :metabase.driver/metadata-type :metabase.driver/metadata-type.mlv2)
->SnakeHatingMap))
([k v & more]
(snake-hating-map (into {k v} (partition-all 2) more)))) |
SSH tunnel support for JDBC-based DWs. TODO -- it seems like this code is JDBC-specific, or at least big parts of
this all. We should consider moving some or all of this code to a new namespace like
| (ns metabase.util.ssh
(:require
[metabase.driver :as driver]
[metabase.models.setting :refer [defsetting]]
[metabase.util :as u]
[metabase.util.i18n :refer [deferred-tru]]
[metabase.util.log :as log])
(:import
(java.io ByteArrayInputStream)
(java.util.concurrent TimeUnit)
(org.apache.sshd.client SshClient)
(org.apache.sshd.client.future ConnectFuture)
(org.apache.sshd.client.session ClientSession)
(org.apache.sshd.client.session.forward PortForwardingTracker)
(org.apache.sshd.common.config.keys FilePasswordProvider
FilePasswordProvider$Decoder
FilePasswordProvider$ResourceDecodeResult)
(org.apache.sshd.common.future CancelOption)
(org.apache.sshd.common.session SessionHeartbeatController$HeartbeatType SessionHolder)
(org.apache.sshd.common.util GenericUtils)
(org.apache.sshd.common.util.io.resource AbstractIoResource)
(org.apache.sshd.common.util.net SshdSocketAddress)
(org.apache.sshd.common.util.security SecurityUtils)
(org.apache.sshd.server.forward AcceptAllForwardingFilter))) |
(defsetting ssh-heartbeat-interval-sec (deferred-tru "Controls how often the heartbeats are sent when an SSH tunnel is established (in seconds).") :visibility :public :type :integer :default 180 :audit :getter) | |
(set! *warn-on-reflection* true) | |
The default port for SSH tunnels (22) used if no port is specified | (def default-ssh-tunnel-port 22) |
(def ^:private ^Long default-ssh-timeout 30000) | |
(def ^:private ^SshClient client
(doto (SshClient/setUpDefaultClient)
(.start)
(.setForwardingFilter AcceptAllForwardingFilter/INSTANCE))) | |
(def ^:private ^"[Lorg.apache.sshd.common.future.CancelOption;" no-cancel-options (make-array CancelOption 0)) | |
(defn- maybe-add-tunnel-password!
[^ClientSession session ^String tunnel-pass]
(when tunnel-pass
(.addPasswordIdentity session tunnel-pass))) | |
(defn- maybe-add-tunnel-private-key!
[^ClientSession session ^String tunnel-private-key tunnel-private-key-passphrase]
(when tunnel-private-key
(let [resource-key (proxy [AbstractIoResource] [(class "key") "key"])
password-provider (proxy [FilePasswordProvider] []
(getPassword [_ _ _]
tunnel-private-key-passphrase)
(handleDecodeAttemptResult [_ _ _ _ _]
FilePasswordProvider$ResourceDecodeResult/TERMINATE)
(decode [_ _ ^FilePasswordProvider$Decoder decoder]
(.decode decoder tunnel-private-key-passphrase)))
ids (with-open [is (ByteArrayInputStream. (.getBytes tunnel-private-key "UTF-8"))]
(SecurityUtils/loadKeyPairIdentities session resource-key is password-provider))
keypair (GenericUtils/head ids)]
(.addPublicKeyIdentity session keypair)))) | |
Opens a new ssh tunnel and returns the connection along with the dynamically assigned tunnel entrance port. It's the callers responsibility to call [[close-tunnel!]] on the returned connection object. | (defn- start-ssh-tunnel!
[{:keys [^String tunnel-host ^Integer tunnel-port ^String tunnel-user tunnel-pass tunnel-private-key
tunnel-private-key-passphrase host port]}]
{:pre [(integer? port)]}
(let [^Integer tunnel-port (or tunnel-port default-ssh-tunnel-port)
^ConnectFuture conn-future (.connect client tunnel-user tunnel-host tunnel-port)
^SessionHolder conn-status (.verify conn-future default-ssh-timeout no-cancel-options)
hb-sec (ssh-heartbeat-interval-sec)
session (doto ^ClientSession (.getSession conn-status)
(maybe-add-tunnel-password! tunnel-pass)
(maybe-add-tunnel-private-key! tunnel-private-key tunnel-private-key-passphrase)
(.setSessionHeartbeat SessionHeartbeatController$HeartbeatType/IGNORE
TimeUnit/SECONDS
hb-sec)
(.. auth (verify default-ssh-timeout no-cancel-options)))
tracker (.createLocalPortForwardingTracker session
(SshdSocketAddress. "" 0)
(SshdSocketAddress. host port))
input-port (.. tracker getBoundAddress getPort)]
(log/trace (u/format-color 'cyan "creating ssh tunnel (heartbeating every %d seconds) %s@%s:%s -L %s:%s:%s"
hb-sec tunnel-user tunnel-host tunnel-port input-port host port))
[session tracker])) |
Is the SSH tunnel currently turned on for these connection details | (defn use-ssh-tunnel? [details] (:tunnel-enabled details)) |
Is the SSH tunnel currently open for these connection details? | (defn ssh-tunnel-open?
[details]
(when-let [session (:tunnel-session details)]
(.isOpen ^ClientSession session))) |
Updates connection details for a data warehouse to use the ssh tunnel host and port For drivers that enter hosts including the protocol (https://host), copy the protocol over as well | (defn include-ssh-tunnel!
[details]
(if (use-ssh-tunnel? details)
(let [[_ proto host] (re-find #"(.*://)?(.*)" (:host details))
[session ^PortForwardingTracker tracker] (start-ssh-tunnel! (assoc details :host host))
tunnel-entrance-port (.. tracker getBoundAddress getPort)
tunnel-entrance-host (.. tracker getBoundAddress getHostName)
orig-port (:port details)
details-with-tunnel (assoc details
:port tunnel-entrance-port ;; This parameter is set dynamically when the connection is established
:host (str proto "localhost") ;; SSH tunnel will always be through localhost
:orig-port orig-port
:tunnel-entrance-host tunnel-entrance-host
:tunnel-entrance-port tunnel-entrance-port ;; the input port is not known until the connection is opened
:tunnel-enabled true
:tunnel-session session
:tunnel-tracker tracker)]
details-with-tunnel)
details)) |
TODO Seems like this definitely belongs in [[metabase.driver.sql-jdbc.connection]] or something like that. | (defmethod driver/incorporate-ssh-tunnel-details :sql-jdbc
[_driver db-details]
(cond (not (use-ssh-tunnel? db-details))
;; no ssh tunnel in use
db-details
(ssh-tunnel-open? db-details)
;; tunnel in use, and is open
db-details
:else
;; tunnel in use, and is not open
(include-ssh-tunnel! db-details))) |
Close a running tunnel session | (defn close-tunnel!
[details]
(when (and (use-ssh-tunnel? details) (ssh-tunnel-open? details))
(log/tracef "Closing SSH tunnel: %s" (:tunnel-session details))
(.close ^ClientSession (:tunnel-session details)))) |
Starts an SSH tunnel, runs the supplied function with the tunnel open, then closes it | (defn do-with-ssh-tunnel
[details f]
(if (use-ssh-tunnel? details)
(let [details-with-tunnel (include-ssh-tunnel! details)]
(try
(log/trace (u/format-color 'cyan "<< OPENED SSH TUNNEL >>"))
(f details-with-tunnel)
(finally
(close-tunnel! details-with-tunnel)
(log/trace (u/format-color 'cyan "<< CLOSED SSH TUNNEL >>")))))
(f details))) |
Starts an ssh tunnel, and binds the supplied name to a database details map with it's values adjusted to use the tunnel TODO -- I think | (defmacro with-ssh-tunnel
[[details-binding details] & body]
`(do-with-ssh-tunnel ~details
(fn [~details-binding]
~@body))) |
Util for building strings | (ns metabase.util.string (:require [clojure.string :as str] [metabase.util.i18n :refer [deferred-tru]])) |
Join parts of a sentence together to build a compound one. Options: - stop? (default true): whether to add a period at the end of the sentence Examples: (build-sentence ["foo" "bar" "baz"]) => "foo, bar and baz." (build-sentence ["foo" "bar" "baz"] :stop? false) => "foo, bar and baz" Note: this assumes we're building a sentence with parts from left to right, It might not works correctly with right-to-left language. Also not all language uses command and "and" to represting 'listing'. | (defn build-sentence
([parts]
(build-sentence parts :stop? true))
([parts & {:keys [stop?]
:or {stop? true}
:as options}]
(when (seq parts)
(cond
(= (count parts) 1) (str (first parts) (when stop? \.))
(= (count parts) 2) (str (first parts) " " (deferred-tru "and") " " (second parts) (when stop? \.))
:else (str (first parts) ", " (build-sentence (rest parts) options)))))) |
Mask string value behind 'start...end' representation. First four and last four symbols are shown. Even less if string is shorter than 8 chars. | (defn mask
([s]
(mask s 4))
([s start-limit]
(mask s start-limit 4))
([s start-limit end-limit]
(if (str/blank? s)
s
(let [cnt (count s)]
(str
(subs s 0 (max 1 (min start-limit (- cnt 2))))
"..."
(when (< (+ end-limit start-limit) cnt)
(subs s (- cnt end-limit) cnt))))))) |
This namespace has clojure implementations of logic currently found in the UI, but is needed for the backend. Idealling code here would be refactored such that the logic for this isn't needed in two places | (ns metabase.util.ui-logic) |
(set! *warn-on-reflection* true) | |
A dimension column is any non-aggregation column | (defn- dimension-column? [col] (not= :aggregation (:source col))) |
A summable column is any numeric column that isn't a relation type like an FK or PK. It also excludes unix
timestamps that are numbers, but with an effective type of | (defn- summable-column?
[{base-type :base_type, effective-type :effective_type, semantic-type :semantic_type}]
(and (isa? base-type :type/Number)
(not (isa? effective-type :type/Temporal))
(not (isa? semantic-type :Relation/*)))) |
A metric column is any non-breakout column that is summable (numeric that isn't a semantic type like an FK/PK/Unix timestamp) | (defn- metric-column?
[col]
(and (not= :breakout (:source col))
(summable-column? col))) |
For graphs with goals, this function returns the index of the default column that should be used to compare against the goal. This follows the frontend code getDefaultLineAreaBarColumns closely with a slight change (detailed in the code) | (defn- default-goal-column-index
[{graph-type :display :as _card} {[col-1 col-2 col-3 :as all-cols] :cols :as _result}]
(let [cols-count (count all-cols)]
(cond
;; Progress goals return a single row and column, compare that
(= :progress graph-type)
0
;; Called DIMENSION_DIMENSION_METRIC in the UI, grab the metric third column for comparison
(and (= cols-count 3)
(dimension-column? col-1)
(dimension-column? col-2)
(metric-column? col-3))
2
;; Called DIMENSION_METRIC in the UI, use the metric column for comparison
(and (= cols-count 2)
(dimension-column? col-1)
(metric-column? col-2))
1
;; Called DIMENSION_METRIC_METRIC in the UI, use the metric column for comparison. The UI returns all of the
;; metric columns here, but that causes an issue around which column the user intended to compare to the
;; goal. The below code always takes the first metric column, this might diverge from the UI
(and (>= cols-count 3)
(dimension-column? col-1)
(every? metric-column? (rest all-cols)))
1
;; If none of the above is true, return nil as we don't know what to compare the goal to
:else nil))) |
The results seq is seq of vectors, this function returns the index in that vector of the given | (defn- column-name->index
[column-name {:keys [cols] :as _result}]
(first (remove nil? (map-indexed (fn [idx column]
(when (.equalsIgnoreCase (name column-name) (name (:name column)))
idx))
cols)))) |
(defn- graph-column-index [viz-kwd card results]
(when-let [metrics-col-index (some-> card
(get-in [:visualization_settings viz-kwd])
first
(column-name->index results))]
(fn [row]
(nth row metrics-col-index)))) | |
This is used as the Y-axis column in the UI | (defn y-axis-rowfn [card results] (graph-column-index :graph.metrics card results)) |
This is used as the X-axis column in the UI | (defn x-axis-rowfn [card results] (graph-column-index :graph.dimensions card results)) |
This is used as the Y-axis column in the UI when we have comboes, which have more than one y axis. | (defn mult-y-axis-rowfn
[card results]
(let [metrics (some-> card
(get-in [:visualization_settings :graph.metrics]))
col-indices (keep #(column-name->index % results) metrics)]
(when (seq col-indices)
(fn [row]
(let [res (vec (for [idx col-indices]
(nth row idx)))]
(if (every? some? res)
res
nil)))))) |
This is used as the X-axis column in the UI when we have comboes, which have more than one x axis. | (defn mult-x-axis-rowfn
[card results]
(let [dimensions (some-> card
(get-in [:visualization_settings :graph.dimensions]))
col-indices (keep #(column-name->index % results) dimensions)]
(when (seq col-indices)
(fn [row]
(let [res (vec (for [idx col-indices]
(nth row idx)))]
(if (every? some? res)
res
nil)))))) |
For a given resultset, return the index of the column that should be used for the goal comparison. This can come from the visualization settings if the column is specified, or from our default column logic | (defn make-goal-comparison-rowfn
[card result]
(if-let [user-specified-rowfn (y-axis-rowfn card result)]
user-specified-rowfn
(when-let [default-col-index (default-goal-column-index card result)]
(fn [row]
(nth row default-col-index))))) |
The goal value can come from a progress goal or a graph goal_value depending on it's type | (defn find-goal-value
[result]
(case (get-in result [:card :display])
(:area :bar :line)
(get-in result [:card :visualization_settings :graph.goal_value])
:progress
(get-in result [:card :visualization_settings :progress.goal])
nil)) |
Utility functions for generating the frontend URLs that correspond various user-facing Metabase objects, like Cards or Dashboards. This is intended as the central place for all such URL-generation activity, so if frontend routes change, only this file need be changed on the backend. Functions for generating URLs not related to Metabase objects generally do not belong here, unless they are used in many places in the codebase; one-off URL-generation functions should go in the same namespaces or modules where they are used. | (ns metabase.util.urls (:require [metabase.public-settings :as public-settings])) |
Return the Notification Link Base URL if set by enterprise env var, or Site URL. | (defn site-url [] (or (public-settings/notification-link-base-url) (public-settings/site-url))) |
Return an appropriate URL to view the archive page. | (defn archive-url [] (str (site-url) "/archive")) |
Return an appropriate URL for a (dashboard-url 10) -> "http://localhost:3000/dashboard/10" | (defn dashboard-url [^Integer id] (format "%s/dashboard/%d" (site-url) id)) |
Return an appropriate URL for a (card-url 10) -> "http://localhost:3000/question/10" | (defn card-url [^Integer id] (format "%s/question/%d" (site-url) id)) |
Return an appropriate URL for a legacy (legacy-pulse-url 10) -> "http://localhost:3000/pulse/10" | (defn legacy-pulse-url [^Integer id] (format "%s/pulse/%d" (site-url) id)) |
Returns an appropriate URL to view a database. (database-url 4) -> "http://localhost:3000/browse/4" | (defn database-url [^Integer db-id] (format "%s/browse/%d" (site-url) db-id)) |
Returns an appropriate URL to view a table. (table-url 1 10) -> "http://localhost:3000/question?db=1&table=10" | (defn table-url [^Integer db-id ^Integer table-id] (format "%s/question?db=%d&table=%d" (site-url) db-id table-id)) |
URL prefix for a public Cards. Get the complete URL by adding the UUID to the end. | (defn public-card-prefix [] (str (site-url) "/public/question/")) |
URL prefix for a public Dashboards. Get the complete URL by adding the UUID to the end. | (defn public-dashboard-prefix [] (str (site-url) "/public/dashboard/")) |
URL for the notification management page in account settings. | (defn notification-management-url [] (str (site-url) "/account/notifications")) |
URL for nonusers to unsubscribe from alerts | (defn unsubscribe-url [] (str (site-url) "/unsubscribe")) |
Return an appropriate URL for a | (defn collection-url [collection-id-or-nil] (format "%s/collection/%s" (site-url) (or collection-id-or-nil "root"))) |
Return an appropriate URL for linking to caching log details. | (defn tools-caching-details-url [^Integer persisted-info-id] (format "%s/admin/tools/model-caching/%d" (site-url) persisted-info-id)) |
Convenience functions for parsing and generating YAML. | (ns metabase.util.yaml
(:refer-clojure :exclude [load])
(:require
#_{:clj-kondo/ignore [:discouraged-namespace]}
[clj-yaml.core :as yaml]
[clojure.java.io :as io]
[clojure.string :as str]
[metabase.util :as u]
[metabase.util.date-2 :as u.date]
[metabase.util.files :as u.files]
[metabase.util.i18n :refer [trs]]
[metabase.util.log :as log])
(:import
(java.nio.file Files Path)
(java.time.temporal Temporal))) |
(set! *warn-on-reflection* true) | |
Returns x with lazy seqs converted to vectors wherever they appear in the data structure. | (defn- vectorized
[x]
(cond
(map? x) (update-vals x vectorized)
(sequential? x) (mapv vectorized x)
:else x)) |
(extend-protocol yaml/YAMLCodec
Temporal
(encode [data]
(u.date/format data))) | |
Returns YAML parsed from file/file-like/path f, with options passed to clj-yaml. | (defn from-file
[f & {:as opts}]
(when (.exists (io/file f))
(with-open [r (io/reader f)]
(vectorized (yaml/parse-stream r opts))))) |
Returns a YAML string from Clojure value x | (defn generate-string
[x & {:as opts}]
(yaml/generate-string x opts)) |
Returns a Clojure object parsed from YAML in string s with opts passed to clj-yaml. | (defn parse-string
[s & {:as opts}]
(vectorized (yaml/parse-string s opts))) |
Legacy API: | |
Load YAML at path | (defn load
([f] (load identity f))
([constructor ^Path f]
(try
(-> f .toUri slurp parse-string constructor)
(catch Exception e
(log/error (trs "Error parsing {0}:\n{1}"
(.getFileName f)
(or (some-> e
ex-data
(select-keys [:error :value])
u/pprint-to-str)
e)))
(throw e))))) |
Load and parse all YAMLs in | (defn load-dir
([dir] (load-dir dir identity))
([dir constructor]
(u.files/with-open-path-to-resource [dir dir]
(with-open [ds (Files/newDirectoryStream dir)]
(->> ds
(filter (comp #(str/ends-with? % ".yaml") u/lower-case-en (memfn ^Path getFileName)))
(mapv (partial load constructor))))))) |
Util functions for dealing with parameters. Primarily used for substituting parameters into variables in Markdown dashboard cards. | (ns metabase.shared.parameters.parameters
#?@
(:clj
[(:require
[clojure.string :as str]
[metabase.mbql.normalize :as mbql.normalize]
[metabase.shared.util.i18n :refer [trs trsn]]
[metabase.util.date-2 :as u.date]
[metabase.util.date-2.parse.builder :as b]
[metabase.util.i18n.impl :as i18n.impl])
(:import
(java.time.format DateTimeFormatter))]
:cljs
[(:require
["moment" :as moment]
[clojure.string :as str]
[metabase.mbql.normalize :as mbql.normalize]
[metabase.shared.util.i18n :refer [trs trsn]])])) |
Formats a value appropriately for inclusion in a text card, based on its type. Does not do any escaping. For datetime parameters, the logic here should mirror the logic (as best as possible) in frontend/src/metabase/parameters/utils/date-formatting.ts Without this comment, the namespace-checker linter incorrectly detects moment as unused | #?(:cljs (comment moment/keep-me)) (defmulti formatted-value (fn [tyype _value _locale] (keyword tyype))) |
(defmethod formatted-value :date/single
[_ value locale]
#?(:cljs (let [m (.locale (moment value) locale)]
(.format m "MMMM D, YYYY"))
:clj (u.date/format "MMMM d, yyyy" (u.date/parse value) locale))) | |
(defmethod formatted-value :date/month-year
[_ value locale]
#?(:cljs (let [m (.locale (moment value "YYYY-MM") locale)]
(if (.isValid m) (.format m "MMMM, YYYY") ""))
:clj (u.date/format "MMMM, yyyy" (u.date/parse value) locale))) | |
#?(:clj
(def ^:private quarter-formatter-in
(b/formatter
"Q" (b/value :iso/quarter-of-year 1) "-" (b/value :year 4)))) | |
#?(:clj
(def ^:private quarter-formatter-out
(b/formatter
"Q" (b/value :iso/quarter-of-year 1) ", " (b/value :year 4)))) | |
(defmethod formatted-value :date/quarter-year
[_ value locale]
#?(:cljs (let [m (.locale (moment value "[Q]Q-YYYY") locale)]
(if (.isValid m) (.format m "[Q]Q, YYYY") ""))
:clj (.format (.withLocale ^DateTimeFormatter quarter-formatter-out (i18n.impl/locale locale))
(.parse ^DateTimeFormatter quarter-formatter-in value)))) | |
(defmethod formatted-value :date/range
[_ value locale]
(let [[start end] (str/split value #"~")]
(if (and start end)
(str (formatted-value :date/single start locale)
" - "
(formatted-value :date/single end locale))
""))) | |
(defn- translated-interval
[interval n]
(case interval
"minutes" (trsn "Minute" "Minutes" n)
"hours" (trsn "Hour" "Hours" n)
"days" (trsn "Day" "Days" n)
"weeks" (trsn "Week" "Weeks" n)
"months" (trsn "Month" "Months" n)
"quarters" (trsn "Quarter" "Quarters" n)
"years" (trsn "Year" "Years" n))) | |
(defn- format-relative-date
[prefix n interval]
(let [n #?(:clj (Integer/valueOf ^String n) :cljs (js/parseInt n))
interval (translated-interval interval n)]
(case [prefix (= n 1)]
["past" true] (trs "Previous {0}" interval)
["past" false] (trs "Previous {0} {1}" n interval)
["next" true] (trs "Next {0}" interval)
["next" false] (trs "Next {0} {1}" n interval)))) | |
(defmethod formatted-value :date/relative
[_ value _]
(condp (fn [re value] (->> (re-find re value) next)) value
#"^today$" (trs "Today")
#"^thisday$" (trs "Today")
#"^thisweek$" (trs "This Week")
#"^thismonth$" (trs "This Month")
#"^thisquarter$" (trs "This Quarter")
#"^thisyear$" (trs "This Year")
#"^past1days$" (trs "Yesterday")
#"^next1days$" (trs "Tomorrow")
#"^(past|next)([0-9]+)([a-z]+)~?$" :>> (fn [matches] (apply format-relative-date matches)))) | |
(defmethod formatted-value :date/all-options
[_ value locale]
;; Test value against a series of regexes (similar to those in metabase/parameters/utils/mbql.js) to determine
;; the appropriate formatting, since it is not encoded in the parameter type.
;; TODO: this is a partial implementation that only handles simple dates
(condp (fn [re value] (->> (re-find re value) second)) value
#"^(this[a-z]+)$" :>> #(formatted-value :date/relative % locale)
#"^~?([0-9-T:]+)~?$" :>> #(formatted-value :date/single % locale)
#"^([0-9-T:]+~[0-9-T:]+)$" :>> #(formatted-value :date/range % locale)
(formatted-value :date/relative value locale))) | |
Given a seq of parameter values, returns them as a single comma-separated string. Does not do additional formatting on the values. | (defn formatted-list
[values]
(condp = (count values)
1 (str (first values))
2 (trs "{0} and {1}" (first values) (second values))
(trs "{0}, {1}, and {2}"
(str/join ", " (drop-last 2 values))
(nth values (- (count values) 2))
(last values)))) |
(defmethod formatted-value :default
[_ value _]
(cond
(sequential? value)
(formatted-list value)
:else
(str value))) | |
Used markdown characters. | (def escaped-chars-regex
#"[\\/*_`'\[\](){}<>#+-.!$@%^&=|\?~]") |
Escape markdown characters. | (defn escape-chars [text regex] (str/replace text regex #(str \\ %))) |
(defn- value
[tag-name tag->param locale escape-markdown]
(let [param (get tag->param tag-name)
value (:value param)
tyype (:type param)]
(when value
(try (cond-> (formatted-value tyype value locale)
escape-markdown (escape-chars escaped-chars-regex))
(catch #?(:clj Throwable :cljs js/Error) _
;; If we got an exception (most likely during date parsing/formatting), fallback to the default
;; implementation of formatted-value
(formatted-value :default value locale)))))) | |
A regex to find template tags in a text card on a dashboard. This should mirror the regex used to find template
tags in native queries, with the exception of snippets and card ID references (see the metabase-lib function
If you modify this, also modify | (def ^:private template-tag-regex
#"\{\{\s*([A-Za-z0-9_\.]+?)\s*\}\}") |
A regex for spliting text around template tags. This should be identical to | (def ^:private template-tag-splitting-regex
#"\{\{\s*[A-Za-z0-9_\.]+?\s*\}\}") |
Represents a variable parsed out of a text card. | (defrecord ^:private TextParam [tag source]
Object
(toString
[x]
(or (:value x) source))) |
(defn- TextParam? [x] (instance? TextParam x)) | |
Given the text of a Markdown card, splits it into a sequence of alternating strings and TextParam records. | (defn- split-on-tags
[text]
(let [split-text (str/split text template-tag-splitting-regex)
matches (map first (re-seq template-tag-regex text))
max-len (max (count split-text) (count matches))
;; Pad both `split-text` and `matches` with empty strings until they are equal length, so that nothing is
;; dropped by the call to `interleave`
padded-text (concat split-text (repeatedly (- max-len (count split-text)) (constantly "")))
padded-matches (concat matches (repeatedly (- max-len (count matches)) (constantly "")))
full-split-text (interleave padded-text padded-matches)]
(map (fn [text]
(if-let [[_, match] (re-matches template-tag-regex text)]
(->TextParam match text)
text))
full-split-text))) |
Given a vector of strings and/or TextParam, concatenate consecutive strings and TextParams without values. | (defn- join-consecutive-strings
[strs-or-vars]
(->> strs-or-vars
(partition-by (fn [str-or-var]
(or (string? str-or-var)
(not (:value str-or-var)))))
(mapcat (fn [strs-or-var]
(if (string? (first strs-or-var))
[(str/join strs-or-var)]
strs-or-var))))) |
Given | (defn- add-values-to-variables
[tag->normalized-param locale escape-markdown split-text]
(map
(fn [maybe-variable]
(if (TextParam? maybe-variable)
(assoc maybe-variable :value (value (:tag maybe-variable) tag->normalized-param locale escape-markdown))
maybe-variable))
split-text)) |
(def ^:private optional-block-regex #"\[\[.+\]\]") | |
(def ^:private non-optional-block-regex #"\[\[(.+?)\]\]") | |
Removes any [[optional]] blocks from individual strings in | (defn- strip-optional-blocks
[split-text]
(let [s (->> split-text
(map #(if (TextParam? %) % (str/replace % optional-block-regex "")))
str/join)]
(str/replace s non-optional-block-regex second))) |
Given the content of a text dashboard card, return a set of the unique names of template tags in the text. | (defn ^:export tag_names
[text]
(let [tag-names (->> (re-seq template-tag-regex (or text ""))
(map second)
set)]
#?(:clj tag-names
:cljs (clj->js tag-names)))) |
Normalize a single parameter by calling [[mbql.normalize/normalize-fragment]] on it, and converting all string keys to keywords. | (defn- normalize-parameter
[parameter]
(-> (mbql.normalize/normalize-fragment [:parameters] [parameter])
first
(update-keys keyword))) |
Given the context of a text dashboard card, replace all template tags in the text with their corresponding values, formatted and escaped appropriately if escape-markdown is true. Specifically escape-markdown should be false when the output isn't being rendered directly as markdown, such as in header cards. | (defn ^:export substitute_tags
([text tag->param]
(substitute_tags text tag->param "en" true))
([text tag->param locale escape-markdown]
(when text
(let [tag->param #?(:clj tag->param
:cljs (js->clj tag->param))
tag->normalized-param (update-vals tag->param normalize-parameter)]
;; Most of the functions in this pipeline are relating to handling optional blocks in the text which use
;; the [[ ]] syntax.
;; For example, given an input "[[a {{b}}]] [[{{c}}]]", where `b` has no value and `c` = 3:
;; 1. `split-on-tags` =>
;; ("[[a " {:tag "b" :source "{{b}}"} "]] [[" {:tag "c" :source "{{c}}"} "]]")
;; 2. `add-values-to-variables` =>
;; ("[[a " {:tag "b" :source "{{b}}" :value nil} "]] [[" {:tag "c" :source "{{c}}" :value 3} "]]")
;; 3. `join-consecutive-strings` => ("[[a {{b}}]] [[" {:tag "b" :source "{{c}}" :value 3} "]]")
;; 4. `strip-optional-blocks` => "3"
(->> text
split-on-tags
(add-values-to-variables tag->normalized-param locale escape-markdown)
join-consecutive-strings
strip-optional-blocks))))) |
(ns metabase.lib.metadata.protocols (:require [metabase.util :as u] #?@(:clj [[potemkin :as p]]))) | |
Protocol for something that we can get information about Tables and Fields from. This can be provided in various ways various ways:
This protocol is pretty limited at this point; in the future, we'll probably want to add:
For all of these methods: if no matching object can be found, you should generally return | (#?(:clj p/defprotocol+ :cljs defprotocol) MetadataProvider
(database [metadata-provider]
"Metadata about the Database we're querying. Should match the [[metabase.lib.metadata/DatabaseMetadata]] schema.
This includes important info such as the supported `:features` and the like.")
(table [metadata-provider table-id]
"Return metadata for a specific Table. Metadata should satisfy [[metabase.lib.metadata/TableMetadata]].")
(field [metadata-provider field-id]
"Return metadata for a specific Field. Metadata should satisfy [[metabase.lib.metadata/ColumnMetadata]].")
(card [metadata-provider card-id]
"Return information about a specific Saved Question, aka a Card. This should
match [[metabase.lib.metadata/CardMetadata]. Currently just used for display name purposes if you have a Card as a
source query.")
(metric [metadata-provider metric-id]
"Return metadata for a particular capital-M Metric, i.e. something from the `metric` table in the application
database. Metadata should match [[metabase.lib.metadata/MetricMetadata]].")
(segment [metadata-provider segment-id]
"Return metadata for a particular captial-S Segment, i.e. something from the `segment` table in the application
database. Metadata should match [[metabase.lib.metadata/SegmentMetadata]]." )
;; these methods are only needed for using the methods BUILDING queries, so they're sort of optional I guess? Things
;; like the Query Processor, which is only manipulating already-built queries, shouldn't need to use these methods.
;; I'm on the fence about maybe putting these in a different protocol. They're part of this protocol for now tho so
;; implement them anyway.
(tables [metadata-provider]
"Return a sequence of Tables in this Database. Tables should satisfy the [[metabase.lib.metadata/TableMetadata]]
schema. This should also include things that serve as 'virtual' tables, e.g. Saved Questions or Models. But users of
MLv2 should not need to know that! If we add support for Super Models or Quantum Questions in the future, they can
just come back from this method in the same shape as everything else, the Query Builder can display them, and the
internals can be tucked away here in MLv2.")
(fields [metadata-provider table-id]
"Return a sequence of Fields associated with a Table with the given `table-id`. Fields should satisfy
the [[metabase.lib.metadata/ColumnMetadata]] schema. If no such Table exists, this should error.")
(metrics [metadata-provider table-id]
"Return a sequence of legacy Metrics associated with a Table with the given `table-id`. Metrics should satisfy
the [[metabase.lib.metadata/MetricMetadata]] schema. If no such Table exists, this should error.")
(segments [metadata-provider table-id]
"Return a sequence of legacy Segments associated with a Table with the given `table-id`. Segments should satisfy
the [[metabase.lib.metadata/SegmentMetadata]] schema. If no Table with ID `table-id` exists, this should error.")
(setting [metadata-provider setting-name]
"Return the value of the given Metabase setting, a keyword.")) |
Whether | (defn metadata-provider? [x] (satisfies? MetadataProvider x)) |
Optional. A protocol for a MetadataProvider that some sort of internal cache. This is mostly useful for MetadataProviders that can hit some sort of relatively expensive external service, e.g. [[metabase.lib.metadata.jvm/application-database-metadata-provider]]. The main purpose of this is to allow pre-warming the cache with stuff that was already fetched elsewhere. See [[metabase.models.metric/warmed-metadata-provider]] for example. See [[cached-metadata-provider]] below to wrap for a way to wrap an existing MetadataProvider to add caching on top of it. | (#?(:clj p/defprotocol+ :cljs defprotocol) CachedMetadataProvider
(cached-database [cached-metadata-provider]
"Get cached metadata for the query's Database.")
(cached-metadata [cached-metadata-provider metadata-type id]
"Get cached metadata of a specific type, e.g. `:metadata/table`.")
(store-database! [cached-metadata-provider database-metadata]
"Store metadata for the query's Database.")
(store-metadata! [cached-metadata-provider metadata-type id metadata]
"Store metadata of a specific type, e.g. `:metadata/table`.")) |
A protocol for a MetadataProvider that can fetch several objects in a single batched operation. This is mostly useful for MetadataProviders e.g. [[metabase.lib.metadata.jvm/application-database-metadata-provider]]. | (#?(:clj p/defprotocol+ :cljs defprotocol) BulkMetadataProvider
(bulk-metadata [bulk-metadata-provider metadata-type ids]
"Fetch lots of metadata of a specific type, e.g. `:metadata/table`, in a single bulk operation.")) |
Convenience. Store several metadata maps at once. | (defn store-metadatas!
[cached-metadata-provider metadata-type metadatas]
(doseq [metadata metadatas]
(store-metadata! cached-metadata-provider metadata-type (u/the-id metadata) metadata))) |
(ns metabase.util.malli.registry (:refer-clojure :exclude [declare def]) (:require [malli.core :as mc] [malli.registry] [malli.util :as mut] #?@(:clj ([malli.experimental.time :as malli.time]))) #?(:cljs (:require-macros [metabase.util.malli.registry]))) | |
(defonce ^:private cache (atom {})) | |
(defn- cached [k schema value-thunk]
(or (get-in @cache [k schema])
(let [v (value-thunk)]
(swap! cache assoc-in [k schema] v)
v))) | |
Fetch a cached [[mc/validator]] for | (defn validator [schema] (cached :validator schema #(mc/validator schema))) |
[[mc/validate]], but uses a cached validator from [[validator]]. | (defn validate [schema value] ((validator schema) value)) |
Fetch a cached [[mc/explainer]] for | (defn explainer
[schema]
(letfn [(make-explainer []
#_{:clj-kondo/ignore [:discouraged-var]}
(let [validator* (mc/validator schema)
explainer* (mc/explainer schema)]
;; for valid values, it's significantly faster to just call the validator. Let's optimize for the 99.9%
;; of calls whose values are valid.
(fn schema-explainer [value]
(when-not (validator* value)
(explainer* value)))))]
(cached :explainer schema make-explainer))) |
[[mc/explain]], but uses a cached explainer from [[explainer]]. | (defn explain [schema value] ((explainer schema) value)) |
(defonce ^:private registry*
(atom (merge (mc/default-schemas)
(mut/schemas)
#?(:clj (malli.time/schemas))))) | |
(defonce ^:private registry (malli.registry/mutable-registry registry*)) | |
(malli.registry/set-default-registry! registry) | |
Register a spec with our Malli spec registry. | (defn register!
[schema definition]
(swap! registry* assoc schema definition)
(reset! cache {})
nil) |
Like [[clojure.spec.alpha/def]]; add a Malli schema to our registry. | #?(:clj
(defmacro def
[type schema]
`(register! ~type ~schema))) |
For REPL/test usage: get the definition of a registered schema from the registry. | (defn resolve-schema [schema] (mc/deref-all (mc/schema schema))) |
(ns metabase.lib.schema.expression.temporal
(:require
[clojure.set :as set]
[malli.core :as mc]
[metabase.lib.hierarchy :as lib.hierarchy]
[metabase.lib.schema.common :as common]
[metabase.lib.schema.expression :as expression]
[metabase.lib.schema.literal :as literal]
[metabase.lib.schema.mbql-clause :as mbql-clause]
[metabase.lib.schema.temporal-bucketing :as temporal-bucketing]
[metabase.shared.util.internal.time-common :as shared.ut.common]
[metabase.util.malli.registry :as mr])
#?@
(:clj
[(:import
(java.time ZoneId))]
:cljs
[(:require
["moment" :as moment]
["moment-timezone" :as mtz])])) | |
#?(:cljs ;; so the moment-timezone stuff gets loaded (comment mtz/keep-me)) (mbql-clause/define-tuple-mbql-clause :interval :- :type/Interval :int ::temporal-bucketing/unit.date-time.interval) | |
(defmethod expression/type-of-method :lib.type-of/type-is-temporal-type-of-first-arg [[_tag _opts temporal]]
;; For datetime-add, datetime-subtract, etc. the first arg is a temporal value. However, some valid values are
;; formatted strings for which type-of returns eg. #{:type/String :type/DateTime}. Since we're doing date arithmetic,
;; we know for sure it's the temporal type.
(let [inner-type (expression/type-of temporal)]
(if (set? inner-type)
(let [temporal-set (set/intersection inner-type #{:type/Date :type/DateTime})]
(if (= (count temporal-set) 1)
(first temporal-set)
temporal-set))
inner-type))) | |
For most purposes, | (lib.hierarchy/derive :lib.type-of/type-is-temporal-type-of-first-arg :lib.type-of/type-is-type-of-first-arg) |
TODO -- we should constrain this so that you can only use a Date unit if expr is a date, etc. | (doseq [op [:datetime-add :datetime-subtract]]
(mbql-clause/define-tuple-mbql-clause op
#_expr [:ref ::expression/temporal]
#_amount :int
#_unit [:ref ::temporal-bucketing/unit.date-time.interval])
(lib.hierarchy/derive op :lib.type-of/type-is-temporal-type-of-first-arg)) |
(doseq [op [:get-year :get-month :get-day :get-hour :get-minute :get-second :get-quarter]]
(mbql-clause/define-tuple-mbql-clause op :- :type/Integer
[:schema [:ref ::expression/temporal]])) | |
(mbql-clause/define-tuple-mbql-clause :datetime-diff :- :type/Integer #_:datetime1 [:schema [:ref ::expression/temporal]] #_:datetime2 [:schema [:ref ::expression/temporal]] #_:unit [:ref ::temporal-bucketing/unit.date-time.truncate]) | |
(doseq [temporal-extract-op #{:get-second :get-minute :get-hour
:get-day :get-day-of-week
:get-month :get-quarter :get-year}]
(mbql-clause/define-tuple-mbql-clause temporal-extract-op :- :type/Integer
#_:datetime [:schema [:ref ::expression/temporal]])) | |
(mr/def ::get-week-mode [:enum :iso :us :instance]) | |
(mbql-clause/define-catn-mbql-clause :get-week :- :type/Integer [:datetime [:schema [:ref ::expression/temporal]]] ;; TODO : the mode should probably go in the options map in modern MBQL rather than have it be a separate positional ;; argument. But we can't refactor everything in one go, so that will have to be a future refactor. [:mode [:? [:schema [:ref ::get-week-mode]]]]) | |
(mr/def ::timezone-id
[:and
::common/non-blank-string
[:or
(into [:enum
{:error/message "valid timezone ID"
:error/fn (fn [{:keys [value]} _]
(str "invalid timezone ID: " (pr-str value)))}]
(sort
#?( ;; 600 timezones on java 17
:clj (ZoneId/getAvailableZoneIds)
;; 596 timezones on moment-timezone 0.5.38
:cljs (.names (.-tz moment)))))
::literal/string.zone-offset]]) | |
(mbql-clause/define-catn-mbql-clause :convert-timezone [:datetime [:schema [:ref ::expression/temporal]]] [:target [:schema [:ref ::timezone-id]]] [:source [:? [:schema [:ref ::timezone-id]]]]) | |
(lib.hierarchy/derive :convert-timezone :lib.type-of/type-is-temporal-type-of-first-arg) | |
(mbql-clause/define-tuple-mbql-clause :now :- :type/DateTimeWithTZ) | |
if | (mr/def ::absolute-datetime.base-type
[:and
[:ref ::common/base-type]
[:fn
{:error/message ":absolute-datetime base-type must derive from :type/Date or :type/DateTime"}
(fn [base-type]
(some #(isa? base-type %)
[:type/Date
:type/DateTime]))]]) |
(mr/def ::absolute-datetime.options
[:merge
[:ref ::common/options]
[:map
[:base-type {:optional true} [:ref ::absolute-datetime.base-type]]]]) | |
(mbql-clause/define-mbql-clause :absolute-datetime
[:cat
{:error/message "valid :absolute-datetime clause"}
[:= :absolute-datetime]
[:schema [:ref ::absolute-datetime.options]]
[:alt
[:cat
{:error/message ":absolute-datetime literal and unit for :type/Date"}
[:schema [:or
[:ref ::literal/date]
;; absolute datetime also allows `year-month` and `year` literals.
[:ref ::literal/string.year-month]
[:ref ::literal/string.year]]]
[:schema [:or
[:= :default]
[:ref ::temporal-bucketing/unit.date]]]]
[:cat
{:error/message ":absolute-datetime literal and unit for :type/DateTime"}
[:schema [:or
[:= :current]
[:ref ::literal/datetime]]]
[:schema [:or
[:= :default]
[:ref ::temporal-bucketing/unit.date-time]]]]]]) | |
(defmethod expression/type-of-method :absolute-datetime
[[_tag _opts value unit]]
(or
;; if value is `:current`, then infer the type based on the unit. Date unit = `:type/Date`. Anything else =
;; `:type/DateTime`.
(when (= value :current)
(cond
(= unit :default) :type/DateTime
(mc/validate ::temporal-bucketing/unit.date unit) :type/Date
:else :type/DateTime))
;; handle year-month and year string regexes, which are not allowed as date literals unless wrapped in
;; `:absolute-datetime`.
(when (string? value)
(cond
(re-matches shared.ut.common/year-month-regex value) :type/Date
(re-matches shared.ut.common/year-regex value) :type/Date))
;; for things that return a union of types like string literals, only the temporal types make sense, so filter out
;; everything else.
(let [value-type (expression/type-of value)
value-type (if (set? value-type)
(into #{} (filter #(isa? % :type/Temporal)) value-type)
value-type)]
(if (and (set? value-type)
(= (count value-type) 1))
(first value-type)
value-type)))) | |
(mr/def ::relative-datetime.amount [:or [:= :current] :int]) | |
(mbql-clause/define-catn-mbql-clause :relative-datetime :- :type/DateTime [:n [:schema [:ref ::relative-datetime.amount]]] [:unit [:? [:schema [:ref ::temporal-bucketing/unit.date-time.interval]]]]) | |
(mbql-clause/define-tuple-mbql-clause :time :- :type/Time #_:timestr [:schema [:ref ::expression/string]] #_:unit [:ref ::temporal-bucketing/unit.time.interval]) | |
(mr/def ::temporal-extract.unit [:enum :year-of-era :quarter-of-year :month-of-year :week-of-year-iso :week-of-year-us :week-of-year-instance :day-of-month :day-of-week :hour-of-day :minute-of-hour :second-of-minute]) | |
(mr/def ::temporal-extract.week-mode [:enum :iso :us :instance]) | |
TODO -- this should make sure unit agrees with the type of expression we're extracting from. | (mbql-clause/define-catn-mbql-clause :temporal-extract :- :type/Integer [:datetime [:schema [:ref ::expression/temporal]]] [:unit [:schema [:ref ::temporal-extract.unit]]] [:mode [:? [:schema [:ref ::temporal-extract.week-mode]]]]) |
Formatters for time values without date information. | (ns metabase.shared.formatting.time
(:require
[metabase.shared.formatting.date :as date]
[metabase.shared.formatting.internal.date-options :as options]
[metabase.shared.util.time :as shared.ut])
#?(:clj
(:import
[java.time.format DateTimeFormatter FormatStyle]))) |
Formats a give time (an hour number, a local time string, or a platform-specific local time object) in the idiomatic style for this locale. For example, ------------------------------------------------- Format Time --------------------------------------------------- | (defn ^:export format-time
[value]
(let [t (shared.ut/coerce-to-time value)]
;; Uses localized time formatting.
(when (shared.ut/valid? t)
#?(:cljs (.format t "LT")
:clj (.format (DateTimeFormatter/ofLocalizedTime FormatStyle/SHORT) t))))) |
Formats the given time (as a string or platform-specific local time or datetime object) based on the | (defn ^:export format-time-with-unit
[value options]
(let [options (-> options options/prepare-options (assoc :date-enabled false))]
(date/format-datetime-with-unit value options))) |
The Metabase Hierarchical Type System (MHTS). This is a hierarchy where types derive from one or more parent types,
which in turn derive from their own parents. This makes it possible to add new types without needing to add
corresponding mappings in the frontend or other places. For example, a Database may want a type called something
like There are a few different keyword hierarchies below: Data (Base/Effective) Types -- keys starting with `:type/` and deriving from `:type/*`, but not `:Semantic/*` or `:Relation/*`The 'base type' represents the actual data type of the column in the data warehouse. The 'effective type' is the
data type we treat this column as; it may be the same as base type or something different if the column has a
coercion strategy (see below). Example: a Coercion Strategies -- keys starting with `:Coercion/`These strategies tell us how to coerce a column from its base type to it effective type when the two differ. For
example, Semantic Types -- types starting with `:type/*` and deriving from `:Semantic/*`NOTE: In the near future we plan to rename the semantic types so they start with These types represent the semantic meaning/interpretation/purpose of a column in the data warehouse, for example
:Semantic types descend from data type(s) that are allowed to have this semantic type. For example,
Relation Type -- types starting with `:type/*` and deriving from `:Relation/*`NOTE: As with Semantic types, in the near future we'll change the relation types so they all start with Types that have to do with whether this column is a primary key or foreign key. These are currently stored in the
Entity Types -- keys starting with `:entity/`These are used to record the semantic purpose of a Table. | (ns metabase.types
(:require
[clojure.set :as set]
[metabase.types.coercion-hierarchies :as coercion-hierarchies]
[metabase.util.malli :as mu]
#?@(:cljs
[[metabase.util :as u]]))) |
Table (entity) Types | |
(derive :entity/GenericTable :entity/*) (derive :entity/UserTable :entity/GenericTable) (derive :entity/CompanyTable :entity/GenericTable) (derive :entity/TransactionTable :entity/GenericTable) (derive :entity/ProductTable :entity/GenericTable) (derive :entity/SubscriptionTable :entity/GenericTable) (derive :entity/EventTable :entity/GenericTable) (derive :entity/GoogleAnalyticsTable :entity/GenericTable) | |
Numeric Types | |
(derive :type/Number :type/*) | |
(derive :type/Integer :type/Number) (derive :type/BigInteger :type/Integer) | |
(derive :type/Quantity :Semantic/*) (derive :type/Quantity :type/Integer) | |
| (derive :type/Float :type/Number) |
| (derive :type/Decimal :type/Float) |
(derive :type/Share :Semantic/*) (derive :type/Share :type/Float) | |
A percent value (generally 0-100) | |
(derive :type/Percentage :Semantic/*) (derive :type/Percentage :type/Decimal) | |
| (derive :type/Currency :type/Decimal) (derive :type/Currency :Semantic/*) (derive :type/Income :type/Currency) (derive :type/Discount :type/Currency) (derive :type/Price :type/Currency) (derive :type/GrossMargin :type/Currency) (derive :type/Cost :type/Currency) |
:type/Location -- anything having to do with a location, e.g. country, city, or coordinates. | (derive :type/Location :Semantic/*) (derive :type/Coordinate :type/Location) (derive :type/Coordinate :type/Float) (derive :type/Latitude :type/Coordinate) (derive :type/Longitude :type/Coordinate) |
(derive :type/Score :Semantic/*) (derive :type/Score :type/Number) | |
(derive :type/Duration :Semantic/*) (derive :type/Duration :type/Number) | |
Text Types | |
(derive :type/Text :type/*) | |
(derive :type/UUID :type/Text) | |
(derive :type/URL :Semantic/*) (derive :type/URL :type/Text) (derive :type/ImageURL :type/URL) (derive :type/AvatarURL :type/ImageURL) | |
(derive :type/Email :Semantic/*) (derive :type/Email :type/Text) | |
Semantic types deriving from | (derive :type/Category :Semantic/*) (derive :type/Enum :Semantic/*) |
(derive :type/Address :type/Location) | |
(derive :type/City :type/Address) (derive :type/City :type/Category) (derive :type/City :type/Text) | |
(derive :type/State :type/Address) (derive :type/State :type/Category) (derive :type/State :type/Text) | |
(derive :type/Country :type/Address) (derive :type/Country :type/Category) (derive :type/Country :type/Text) | |
(derive :type/ZipCode :type/Address) (derive :type/ZipCode :type/Text) | |
(derive :type/Name :type/Category) (derive :type/Name :type/Text) (derive :type/Title :type/Category) (derive :type/Title :type/Text) | |
(derive :type/Description :Semantic/*) (derive :type/Description :type/Text) (derive :type/Comment :Semantic/*) (derive :type/Comment :type/Text) | |
(derive :type/PostgresEnum :type/Text) | |
DateTime Types | |
(derive :type/Temporal :type/*) | |
(derive :type/Date :type/Temporal) | |
You could have Dates with TZ info but it's not supported by JSR-310 so we'll not worry about that for now. | |
(derive :type/Time :type/Temporal) (derive :type/TimeWithTZ :type/Time) (derive :type/TimeWithLocalTZ :type/TimeWithTZ) ; a column that is timezone-aware, but normalized to UTC or another offset at rest. | |
(derive :type/TimeWithZoneOffset :type/TimeWithTZ) ; a column that stores its timezone offset | |
(derive :type/DateTime :type/Temporal) (derive :type/DateTimeWithTZ :type/DateTime) (derive :type/DateTimeWithLocalTZ :type/DateTimeWithTZ) ; a column that is timezone-aware, but normalized to UTC or another offset at rest. | |
(derive :type/DateTimeWithZoneOffset :type/DateTimeWithTZ) ; a column that stores its timezone offset, e.g. `-08:00` | |
(derive :type/DateTimeWithZoneID :type/DateTimeWithTZ) ; a column that stores its timezone ID, e.g. `US/Pacific` | |
An
| (derive :type/Instant :type/DateTimeWithLocalTZ) |
TODO -- shouldn't we have a | |
(derive :type/CreationTemporal :Semantic/*) (derive :type/CreationTimestamp :type/CreationTemporal) (derive :type/CreationTimestamp :type/DateTime) (derive :type/CreationTime :type/CreationTemporal) (derive :type/CreationTime :type/Time) (derive :type/CreationDate :type/CreationTemporal) (derive :type/CreationDate :type/Date) | |
(derive :type/JoinTemporal :Semantic/*) (derive :type/JoinTimestamp :type/JoinTemporal) (derive :type/JoinTimestamp :type/DateTime) (derive :type/JoinTime :type/JoinTemporal) (derive :type/JoinTime :type/Time) (derive :type/JoinDate :type/JoinTemporal) (derive :type/JoinDate :type/Date) | |
(derive :type/CancelationTemporal :Semantic/*) (derive :type/CancelationTimestamp :type/CancelationTemporal) (derive :type/CancelationTimestamp :type/DateTime) (derive :type/CancelationTime :type/CancelationTemporal) (derive :type/CancelationTime :type/Date) (derive :type/CancelationDate :type/CancelationTemporal) (derive :type/CancelationDate :type/Date) | |
(derive :type/DeletionTemporal :Semantic/*) (derive :type/DeletionTimestamp :type/DeletionTemporal) (derive :type/DeletionTimestamp :type/DateTime) (derive :type/DeletionTime :type/DeletionTemporal) (derive :type/DeletionTime :type/Time) (derive :type/DeletionDate :type/DeletionTemporal) (derive :type/DeletionDate :type/Date) | |
(derive :type/UpdatedTemporal :Semantic/*) (derive :type/UpdatedTimestamp :type/UpdatedTemporal) (derive :type/UpdatedTimestamp :type/DateTime) (derive :type/UpdatedTime :type/UpdatedTemporal) (derive :type/UpdatedTime :type/Time) (derive :type/UpdatedDate :type/UpdatedTemporal) (derive :type/UpdatedDate :type/Date) | |
(derive :type/Birthdate :Semantic/*) (derive :type/Birthdate :type/Date) | |
(derive :type/Interval :type/Temporal) | |
Other | |
(derive :type/Boolean :type/*) (derive :type/DruidHyperUnique :type/*) | |
Text-Like Types: Things that should be displayed as text for most purposes but that shouldn't support advanced filter options like starts with / contains | |
(derive :type/TextLike :type/*) (derive :type/MongoBSONID :type/TextLike) | |
IP address can be either a data type e.g. Postgres | (derive :type/IPAddress :type/TextLike) (derive :type/IPAddress :Semantic/*) |
Structured/Collections | |
(derive :type/Collection :type/*) (derive :type/Structured :type/*) | |
(derive :type/Dictionary :type/Collection) (derive :type/Array :type/Collection) | |
| (derive :type/JSON :type/Structured) (derive :type/JSON :type/Collection) |
| (derive :type/XML :type/Structured) (derive :type/XML :type/Collection) |
base type = :type/Text coercion strategy = :Coercion/SerializedJSON effective type = :type/JSON but for the time being we'll have to live with these being "weird" semantic types. | (derive :type/Structured :Semantic/*) (derive :type/Structured :type/Text) |
(derive :type/SerializedJSON :type/Structured) (derive :type/XML :type/Structured) | |
Other | |
(derive :type/User :Semantic/*) (derive :type/Author :type/User) (derive :type/Owner :type/User) | |
(derive :type/Product :type/Category) (derive :type/Company :type/Category) (derive :type/Subscription :type/Category) | |
(derive :type/Source :type/Category) | |
Relation types | |
(derive :type/FK :Relation/*) (derive :type/PK :Relation/*) | |
Coercion strategies | |
(derive :Coercion/String->Temporal :Coercion/*) (derive :Coercion/ISO8601->Temporal :Coercion/String->Temporal) (derive :Coercion/ISO8601->DateTime :Coercion/ISO8601->Temporal) (derive :Coercion/ISO8601->Time :Coercion/ISO8601->Temporal) (derive :Coercion/ISO8601->Date :Coercion/ISO8601->Temporal) | |
(derive :Coercion/YYYYMMDDHHMMSSString->Temporal :Coercion/String->Temporal) | |
(derive :Coercion/Bytes->Temporal :Coercion/*) (derive :Coercion/YYYYMMDDHHMMSSBytes->Temporal :Coercion/Bytes->Temporal) | |
(derive :Coercion/Number->Temporal :Coercion/*) (derive :Coercion/UNIXTime->Temporal :Coercion/Number->Temporal) (derive :Coercion/UNIXSeconds->DateTime :Coercion/UNIXTime->Temporal) (derive :Coercion/UNIXMilliSeconds->DateTime :Coercion/UNIXTime->Temporal) (derive :Coercion/UNIXMicroSeconds->DateTime :Coercion/UNIXTime->Temporal) (derive :Coercion/UNIXNanoSeconds->DateTime :Coercion/UNIXTime->Temporal) | |
---------------------------------------------------- Util Fns ---------------------------------------------------- | |
E.g. the version coming back from the app DB as opposed to MLv2 metadata. This should eventually be considered deprecated. | (def ^:private SnakeCasedField [:map [:base_type :any]]) |
True if a Metabase | (mu/defn field-is-type?
[tyype :- :keyword
{base-type :base_type, effective-type :effective_type} :- SnakeCasedField]
(some #(isa? % tyype) [base-type effective-type])) |
True if a Metabase | (mu/defn temporal-field? [field :- SnakeCasedField] (field-is-type? :type/Temporal field)) |
(def ^:private assignable-hierarchy (make-hierarchy)) | |
Declare that a value of type | (defn declare-assignable
[x y]
#?(:clj (alter-var-root #'assignable-hierarchy derive x y)
:cljs (set! assignable-hierarchy (derive assignable-hierarchy x y)))) |
(declare-assignable :type/Integer :type/Decimal) | |
Is a value of type When deciding assignability, We also consider the type hierarchy. If x is assignable to z and z is a y, then x is also assignable to y. Also, if z is assignable to y and x is an z, then x is assignable to y. | (defn assignable?
[x y]
(or (isa? assignable-hierarchy x y)
(boolean (some #(assignable? x %) (descendants y)))
(boolean (some #(assignable? % y) (parents x))))) |
Impl for [[most-specific-common-ancestor]]. | (defn- most-specific-common-ancestor*
[x y]
(cond
(= x :type/*) nil
(= y :type/*) nil
(assignable? x y) y
(assignable? y x) x
;; if we haven't had a match yet, recursively try using parent types.
:else
(some (fn [x']
(some (fn [y']
(when-not (= [x' y'] [x y])
(most-specific-common-ancestor* x' y')))
(cons y (parents y))))
(cons x (parents x))))) |
Return the most-specific type that is an ancestor of both (most-specific-common-ancestor :type/BigInteger :type/Decimal) => :type/Number | (defn most-specific-common-ancestor
[x y]
(or (most-specific-common-ancestor* x y)
:type/*)) |
#?(:cljs
(defn ^:export isa
"Is `x` the same as, or a descendant type of, `y`?"
[x y]
(isa? (keyword x) (keyword y))))
#?(:cljs
(def ^:export TYPE
"A map of Type name (as string, without `:type/` namespace) -> qualified type name as string
{\"Temporal\" \"type/Temporal\", ...}"
(clj->js (into {} (for [tyype (distinct (mapcat descendants [:type/* :Semantic/* :Relation/*]))]
[(name tyype) (u/qualified-name tyype)])))))
(coercion-hierarchies/define-types! :Coercion/UNIXNanoSeconds->DateTime #{:type/Integer :type/Decimal} :type/Instant)
(coercion-hierarchies/define-types! :Coercion/UNIXMicroSeconds->DateTime #{:type/Integer :type/Decimal} :type/Instant)
(coercion-hierarchies/define-types! :Coercion/UNIXMilliSeconds->DateTime #{:type/Integer :type/Decimal} :type/Instant)
(coercion-hierarchies/define-types! :Coercion/UNIXSeconds->DateTime #{:type/Integer :type/Decimal} :type/Instant)
(coercion-hierarchies/define-types! :Coercion/ISO8601->Date :type/Text :type/Date)
(coercion-hierarchies/define-types! :Coercion/ISO8601->DateTime :type/Text :type/DateTime)
(coercion-hierarchies/define-types! :Coercion/ISO8601->Time :type/Text :type/Time) | |
(coercion-hierarchies/define-types! :Coercion/YYYYMMDDHHMMSSString->Temporal :type/Text :type/DateTime) | |
(coercion-hierarchies/define-non-inheritable-type! :Coercion/YYYYMMDDHHMMSSBytes->Temporal :type/* :type/DateTime) | |
Whether | (defn is-coercible-from?
[coercion-strategy base-type]
(or (isa? (coercion-hierarchies/base-type-hierarchy) base-type coercion-strategy)
(boolean (some-> (coercion-hierarchies/non-descending-strategies)
(get base-type)
(contains? coercion-strategy))))) |
Whether | (defn is-coercible-to? [coercion-strategy effective-type] (isa? (coercion-hierarchies/effective-type-hierarchy) coercion-strategy effective-type)) |
Whether | (defn is-coercible?
[coercion-strategy base-type effective-type]
(and (is-coercible-from? coercion-strategy base-type)
(is-coercible-to? coercion-strategy effective-type))) |
Possible coercions for a base type, returned as a map of | (defn coercion-possibilities
[base-type]
(let [base-type-hierarchy (coercion-hierarchies/base-type-hierarchy)
effective-type-hierarchy (coercion-hierarchies/effective-type-hierarchy)]
(->> (for [strategy (ancestors base-type-hierarchy base-type)
:when (isa? strategy :Coercion/*)
:let [effective-types (parents effective-type-hierarchy strategy)]
effective-type effective-types
:when (not (isa? effective-type :Coercion/*))]
{effective-type #{strategy}})
(reduce (partial merge-with set/union)
(select-keys (coercion-hierarchies/non-descending-strategies) [base-type]))
not-empty))) |
Returns a boolean of whether a field base-type has any coercion strategies available. | (defn ^:export is_coerceable [base-type] (boolean (not-empty (coercion-possibilities (keyword base-type))))) |
The effective type resulting from a coercion. | (defn effective-type-for-coercion [coercion] (coercion-hierarchies/effective-type-for-strategy coercion)) |
Coercions available for a type. In cljs will return a js array of strings like ["Coercion/ISO8601->Time" ...]. In clojure will return a sequence of keywords. | (defn ^:export coercions_for_type
[base-type]
(let [applicable (into () (comp (distinct) cat)
(vals (coercion-possibilities (keyword base-type))))]
#?(:cljs
(clj->js (map (fn [kw] (str (namespace kw) "/" (name kw)))
applicable))
:clj
applicable))) |
Utility functions used by the Queries in metabase-lib. | (ns metabase.domain-entities.queries.util (:require [metabase.util.malli :as mu] #?@(:cljs ([metabase.domain-entities.converters :as converters])))) |
Schema for an Expression that's part of a query filter. | (def Expression :any) |
Malli schema for a map of expressions by name. | (def ExpressionMap [:map-of string? Expression]) |
Malli schema for a list of {:name :expression} maps. | (def ExpressionList [:vector [:map [:name string?] [:expression Expression]]]) |
(def ^:private ->expression-map
#?(:cljs (converters/incoming ExpressionMap)
:clj identity)) | |
(def ^:private expression-list->
#?(:cljs (converters/outgoing ExpressionList)
:clj identity)) | |
(mu/defn ^:export expressions-list :- ExpressionList
"Turns a map of expressions by name into a list of `{:name name :expression expression}` objects."
[expressions :- ExpressionMap]
(->> expressions
->expression-map
(mapv (fn [[name expr]] {:name name :expression expr}))
expression-list->)) | |
(defn- unique-name [names original-name index]
(let [indexed-name (str original-name " (" index ")")]
(if (names indexed-name)
(recur names original-name (inc index))
indexed-name))) | |
(mu/defn ^:export unique-expression-name :- string?
"Generates an expression name that's unique in the given map of expressions."
[expressions :- ExpressionMap
original-name :- string?]
(let [expression-names (-> expressions ->expression-map keys set)]
(if (not (expression-names original-name))
original-name
(let [re-duplicates (re-pattern (str "^" original-name " \\([0-9]+\\)$"))
duplicates (set (filter #(or (= % original-name)
(re-matches re-duplicates %))
expression-names))]
(unique-name duplicates original-name (count duplicates)))))) | |
Utilitiy functions for working with MBQL queries. | (ns metabase.mbql.util
(:refer-clojure :exclude [replace])
(:require
[clojure.string :as str]
[metabase.lib.schema.common :as lib.schema.common]
[metabase.mbql.predicates :as mbql.preds]
[metabase.mbql.schema :as mbql.s]
[metabase.mbql.schema.helpers :as schema.helpers]
[metabase.mbql.util.match :as mbql.match]
[metabase.shared.util.i18n :as i18n]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
#?@(:clj
[[metabase.models.dispatch :as models.dispatch]
[potemkin :as p]]))) |
Like | (defn qualified-name
[x]
(if (and (keyword? x) (namespace x))
(str (namespace x) "/" (name x))
(name x))) |
(mu/defn normalize-token :- :keyword
"Convert a string or keyword in various cases (`lisp-case`, `snake_case`, or `SCREAMING_SNAKE_CASE`) to a lisp-cased
keyword."
[token :- schema.helpers/KeywordOrString]
#_{:clj-kondo/ignore [:discouraged-var]}
(-> (qualified-name token)
str/lower-case
(str/replace #"_" "-")
keyword)) | |
True if | (defn mbql-clause?
[x]
(and (sequential? x)
(not (map-entry? x))
(keyword? (first x)))) |
If (is-clause? :count [:count 10]) ; -> true (is-clause? #{:+ :- :* :/} [:+ 10 20]) ; -> true | (defn is-clause?
[k-or-ks x]
(and
(mbql-clause? x)
(if (coll? k-or-ks)
((set k-or-ks) (first x))
(= k-or-ks (first x))))) |
Returns (check-clause :count [:count 10]) ; => [:count 10] (check-clause? #{:+ :- :* :/} [:+ 10 20]) ; -> [:+ 10 20] (check-clause :sum [:count 10]) ; => nil | (defn check-clause
[k-or-ks x]
(when (is-clause? k-or-ks x)
x)) |
+----------------------------------------------------------------------------------------------------------------+ | Functions for manipulating queries | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- combine-compound-filters-of-type [compound-type subclauses]
(mapcat #(mbql.match/match-one %
[(_ :guard (partial = compound-type)) & args]
args
_
[&match])
subclauses)) | |
(declare simplify-compound-filter) | |
(defn- simplify-and-or-filter
[op args]
(let [args (distinct (filter some? args))]
(case (count args)
;; an empty filter, toss it
0 nil
;; single arg, unwrap it
1 (simplify-compound-filter (first args))
(if (some (partial is-clause? op) args)
;; clause of the same type embedded, faltten it
(recur op (combine-compound-filters-of-type op args))
;; simplify the arguments
(let [simplified (map simplify-compound-filter args)]
(if (= simplified args)
;; no change, we can stop
(into [op] args)
;; there is a change, we might be able to simplify even further
(recur op simplified))))))) | |
Simplify compound | (defn simplify-compound-filter
[x]
(cond
;; look for filters in the values
(map? x) (update-vals x simplify-compound-filter)
(seq? x) (recur (vec x))
;; not a map and not vector, leave it as is
(not (vector? x)) x
;; an empty filter, toss it
(not (some some? x)) nil
:else (let [[op & [farg :as args]] x]
(case op
:not (if-not (seqable? farg)
x
(case (first farg)
;; double negation, eliminate both
:not (recur (second farg))
;; use de Morgan's law to push the negation down
:and (simplify-and-or-filter :or (map #(vector :not %) (rest farg)))
:or (simplify-and-or-filter :and (map #(vector :not %) (rest farg)))
x))
:and (simplify-and-or-filter :and args)
:or (simplify-and-or-filter :or args)
;; simplify the elements of the vector
(mapv simplify-compound-filter x))))) |
(mu/defn combine-filter-clauses :- mbql.s/Filter "Combine two filter clauses into a single clause in a way that minimizes slapping a bunch of `:and`s together if possible." [filter-clause & more-filter-clauses] (simplify-compound-filter (cons :and (cons filter-clause more-filter-clauses)))) | |
(mu/defn add-filter-clause-to-inner-query :- mbql.s/MBQLQuery
"Add a additional filter clause to an *inner* MBQL query, merging with the existing filter clause with `:and` if
needed."
[inner-query :- mbql.s/MBQLQuery
new-clause :- [:maybe mbql.s/Filter]]
(if-not new-clause
inner-query
(update inner-query :filter combine-filter-clauses new-clause))) | |
(mu/defn add-filter-clause :- mbql.s/Query "Add an additional filter clause to an `outer-query`. If `new-clause` is `nil` this is a no-op." [outer-query :- mbql.s/Query new-clause :- [:maybe mbql.s/Filter]] (update outer-query :query add-filter-clause-to-inner-query new-clause)) | |
Rewrite | (defn desugar-inside
[m]
(mbql.match/replace m
[:inside lat-field lon-field lat-max lon-min lat-min lon-max]
[:and
[:between lat-field lat-min lat-max]
[:between lon-field lon-min lon-max]])) |
Rewrite | (defn desugar-is-null-and-not-null
[m]
(mbql.match/replace m
[:is-null field] [:= field nil]
[:not-null field] [:!= field nil])) |
Rewrite | (defn desugar-is-empty-and-not-empty
[m]
(mbql.match/replace m
[:is-empty field] [:or [:= field nil] [:= field ""]]
[:not-empty field] [:and [:!= field nil] [:!= field ""]])) |
Replace a field or expression inside :time-interval | (defn- replace-field-or-expression
[m unit]
(mbql.match/replace m
[:field id-or-name opts] [:field id-or-name (assoc opts :temporal-unit unit)]
[:expression expression-name] [:expression expression-name])) |
Rewrite | (defn desugar-time-interval
[m]
(mbql.match/replace m
[:time-interval field-or-expression n unit] (recur [:time-interval field-or-expression n unit nil])
;; replace current/last/next with corresponding value of n and recur
[:time-interval field-or-expression :current unit options] (recur [:time-interval field-or-expression 0 unit options])
[:time-interval field-or-expression :last unit options] (recur [:time-interval field-or-expression -1 unit options])
[:time-interval field-or-expression :next unit options] (recur [:time-interval field-or-expression 1 unit options])
[:time-interval field-or-expression (n :guard #{-1}) unit (_ :guard :include-current)]
[:between
(replace-field-or-expression field-or-expression unit)
[:relative-datetime n unit]
[:relative-datetime 0 unit]]
[:time-interval field-or-expression (n :guard #{1}) unit (_ :guard :include-current)]
[:between
(replace-field-or-expression field-or-expression unit)
[:relative-datetime 0 unit]
[:relative-datetime n unit]]
[:time-interval field-or-expression (n :guard #{-1 0 1}) unit _]
[:= (replace-field-or-expression field-or-expression unit) [:relative-datetime n unit]]
[:time-interval field-or-expression (n :guard neg?) unit (_ :guard :include-current)]
[:between
(replace-field-or-expression field-or-expression unit)
[:relative-datetime n unit]
[:relative-datetime 0 unit]]
[:time-interval field-or-expression (n :guard neg?) unit _]
[:between
(replace-field-or-expression field-or-expression unit)
[:relative-datetime n unit]
[:relative-datetime -1 unit]]
[:time-interval field-or-expression n unit (_ :guard :include-current)]
[:between
(replace-field-or-expression field-or-expression unit)
[:relative-datetime 0 unit]
[:relative-datetime n unit]]
[:time-interval field-or-expression n unit _]
[:between
(replace-field-or-expression field-or-expression unit)
[:relative-datetime 1 unit]
[:relative-datetime n unit]])) |
Rewrite | (defn desugar-does-not-contain
[m]
(mbql.match/replace m
[:does-not-contain & args]
[:not (into [:contains] args)])) |
[:= field x y] -> [:or [:= field x] [:= field y]] [:!= field x y] -> [:and [:!= field x] [:!= field y]] | (defn desugar-equals-and-not-equals-with-extra-args
[m]
(mbql.match/replace m
[:= field x y & more]
(apply vector :or (for [x (concat [x y] more)]
[:= field x]))
[:!= field x y & more]
(apply vector :and (for [x (concat [x y] more)]
[:!= field x])))) |
Replace | (defn desugar-current-relative-datetime
[m]
(mbql.match/replace m
[clause field & (args :guard (partial some (partial = [:relative-datetime :current])))]
(let [temporal-unit (or (mbql.match/match-one field [:field _ {:temporal-unit temporal-unit}] temporal-unit)
:default)]
(into [clause field] (mbql.match/replace args
[:relative-datetime :current]
[:relative-datetime 0 temporal-unit]))))) |
Mapping from the sugar syntax to extract datetime to the unit. | (def temporal-extract-ops->unit
{[:get-year nil] :year-of-era
[:get-quarter nil] :quarter-of-year
[:get-month nil] :month-of-year
;; default get-week mode is iso
[:get-week nil] :week-of-year-iso
[:get-week :iso] :week-of-year-iso
[:get-week :us] :week-of-year-us
[:get-week :instance] :week-of-year-instance
[:get-day nil] :day-of-month
[:get-day-of-week nil] :day-of-week
[:get-hour nil] :hour-of-day
[:get-minute nil] :minute-of-hour
[:get-second nil] :second-of-minute}) |
(def ^:private temporal-extract-ops
(->> (keys temporal-extract-ops->unit)
(map first)
set)) | |
Replace datetime extractions clauses like | (defn desugar-temporal-extract
[m]
(mbql.match/replace m
[(op :guard temporal-extract-ops) field & args]
[:temporal-extract field (temporal-extract-ops->unit [op (first args)])])) |
(defn- desugar-divide-with-extra-args [expression]
(mbql.match/replace expression
[:/ x y z & more]
(recur (into [:/ [:/ x y]] (cons z more))))) | |
(mu/defn desugar-expression :- mbql.s/FieldOrExpressionDef
"Rewrite various 'syntactic sugar' expressions like `:/` with more than two args into something simpler for drivers
to compile."
[expression :- mbql.s/FieldOrExpressionDef]
(-> expression
desugar-divide-with-extra-args)) | |
(defn- maybe-desugar-expression [clause]
(cond-> clause
(mbql.preds/FieldOrExpressionDef? clause) desugar-expression)) | |
(mu/defn desugar-filter-clause :- mbql.s/Filter
"Rewrite various 'syntatic sugar' filter clauses like `:time-interval` and `:inside` as simpler, logically
equivalent clauses. This can be used to simplify the number of filter clauses that need to be supported by anything
that needs to enumerate all the possible filter types (such as driver query processor implementations, or the
implementation [[negate-filter-clause]] below.)"
[filter-clause :- mbql.s/Filter]
(-> filter-clause
desugar-current-relative-datetime
desugar-equals-and-not-equals-with-extra-args
desugar-does-not-contain
desugar-time-interval
desugar-is-null-and-not-null
desugar-is-empty-and-not-empty
desugar-inside
simplify-compound-filter
desugar-temporal-extract
maybe-desugar-expression)) | |
(defmulti ^:private negate* first) | |
(defmethod negate* :not [[_ subclause]] subclause) (defmethod negate* :and [[_ & subclauses]] (into [:or] (map negate* subclauses))) (defmethod negate* :or [[_ & subclauses]] (into [:and] (map negate* subclauses))) (defmethod negate* := [[_ field value]] [:!= field value]) (defmethod negate* :!= [[_ field value]] [:= field value]) (defmethod negate* :> [[_ field value]] [:<= field value]) (defmethod negate* :< [[_ field value]] [:>= field value]) (defmethod negate* :>= [[_ field value]] [:< field value]) (defmethod negate* :<= [[_ field value]] [:> field value]) | |
(defmethod negate* :between [[_ field min max]] [:or [:< field min] [:> field max]]) | |
(defmethod negate* :contains [clause] [:not clause]) (defmethod negate* :starts-with [clause] [:not clause]) (defmethod negate* :ends-with [clause] [:not clause]) | |
(mu/defn negate-filter-clause :- mbql.s/Filter "Return the logical compliment of an MBQL filter clause, generally without using `:not` (except for the string filter clause types). Useful for generating highly optimized filter clauses and for drivers that do not support top-level `:not` filter clauses." [filter-clause :- mbql.s/Filter] (-> filter-clause desugar-filter-clause negate* simplify-compound-filter)) | |
(mu/defn query->source-table-id :- [:maybe ::lib.schema.common/positive-int]
"Return the source Table ID associated with `query`, if applicable; handles nested queries as well. If `query` is
`nil`, returns `nil`.
Throws an Exception when it encounters a unresolved source query (i.e., the `:source-table \"card__id\"`
form), because it cannot return an accurate result for a query that has not yet been preprocessed."
{:arglists '([outer-query])}
[{{source-table-id :source-table, source-query :source-query} :query, query-type :type, :as query} :- [:maybe :map]]
(cond
;; for native queries, there's no source table to resolve
(not= query-type :query)
nil
;; for MBQL queries with a *native* source query, it's the same story
(and (nil? source-table-id) source-query (:native source-query))
nil
;; for MBQL queries with an MBQL source query, recurse on the source query and try again
(and (nil? source-table-id) source-query)
(recur (assoc query :query source-query))
;; if ID is a `card__id` form that can only mean we haven't preprocessed the query and resolved the source query.
;; This is almost certainly an accident, so throw an Exception so we can make the proper fixes
((every-pred string? (partial re-matches mbql.s/source-table-card-id-regex)) source-table-id)
(throw
(ex-info
(i18n/tru "Error: query''s source query has not been resolved. You probably need to `preprocess` the query first.")
{}))
;; otherwise resolve the source Table
:else
source-table-id)) | |
(mu/defn join->source-table-id :- [:maybe ::lib.schema.common/positive-int]
"Like `query->source-table-id`, but for a join."
[join]
(query->source-table-id {:type :query, :query join})) | |
(mu/defn add-order-by-clause :- mbql.s/MBQLQuery
"Add a new `:order-by` clause to an MBQL `inner-query`. If the new order-by clause references a Field that is
already being used in another order-by clause, this function does nothing."
[inner-query :- mbql.s/MBQLQuery
[_ [_ id-or-name :as _field], :as order-by-clause] :- mbql.s/OrderBy]
(let [existing-fields (set (for [[_ [_ id-or-name]] (:order-by inner-query)]
id-or-name))]
(if (existing-fields id-or-name)
;; Field already referenced, nothing to do
inner-query
;; otherwise add new clause at the end
(update inner-query :order-by (comp vec distinct conj) order-by-clause)))) | |
Dispatch function perfect for use with multimethods that dispatch off elements of an MBQL query. If | (defn dispatch-by-clause-name-or-class
([x]
(letfn [(clause-type [x]
(when (mbql-clause? x)
(first x)))
(mlv2-lib-type [x]
(when (map? x)
(:lib/type x)))
(model-type [#?(:clj x :cljs _x)]
#?(:clj (models.dispatch/model x)
:cljs nil))]
(or
(clause-type x)
(mlv2-lib-type x)
(model-type x)
(type x))))
([x _]
(dispatch-by-clause-name-or-class x))) |
(mu/defn expression-with-name :- mbql.s/FieldOrExpressionDef
"Return the `Expression` referenced by a given `expression-name`."
[inner-query expression-name :- [:or :keyword ::lib.schema.common/non-blank-string]]
(let [allowed-names [(qualified-name expression-name) (keyword expression-name)]]
(loop [{:keys [expressions source-query]} inner-query, found #{}]
(or
;; look for either string or keyword version of `expression-name` in `expressions`
(some (partial get expressions) allowed-names)
;; otherwise, if we have a source query recursively look in that (do we allow that??)
(let [found (into found (keys expressions))]
(if source-query
(recur source-query found)
;; failing that throw an Exception with detailed info about what we tried and what the actual expressions
;; were
(throw (ex-info (i18n/tru "No expression named ''{0}''" (qualified-name expression-name))
{:type :invalid-query
:expression-name expression-name
:tried allowed-names
:found found})))))))) | |
(mu/defn aggregation-at-index :- mbql.s/Aggregation
"Fetch the aggregation at index. This is intended to power aggregate field references (e.g. [:aggregation 0]).
This also handles nested queries, which could be potentially ambiguous if multiple levels had aggregations. To
support nested queries, you'll need to keep tract of how many `:source-query`s deep you've traveled; pass in this
number to as optional arg `nesting-level` to make sure you reference aggregations at the right level of nesting."
([query index]
(aggregation-at-index query index 0))
([query :- mbql.s/Query
index :- ::lib.schema.common/int-greater-than-or-equal-to-zero
nesting-level :- ::lib.schema.common/int-greater-than-or-equal-to-zero]
(if (zero? nesting-level)
(or (nth (get-in query [:query :aggregation]) index)
(throw (ex-info (i18n/tru "No aggregation at index: {0}" index) {:index index})))
;; keep recursing deeper into the query until we get to the same level the aggregation reference was defined at
(recur {:query (get-in query [:query :source-query])} index (dec nesting-level))))) | |
Is this ID (presumably of a Metric or Segment) a GA one? | (defn ga-id?
[id]
(boolean
(when ((some-fn string? keyword?) id)
(re-find #"^ga(id)?:" (name id))))) |
Is this metric or segment clause not a Metabase Metric or Segment, but rather a GA one? E.g. something like `[:metric ga:users]`. We want to ignore those because they're not the same thing at all as MB Metrics/Segments and don't correspond to objects in our application DB. | (defn ga-metric-or-segment? [[_ id]] (ga-id? id)) |
--------------------------------- Unique names & transforming ags to have names ---------------------------------- | |
Return a function that can be used to uniquify string names. Function maintains an internal counter that will suffix any names passed to it as needed so all results will be unique. (let [unique-name (unique-name-generator)] [(unique-name "A") (unique-name "B") (unique-name "A")]) ;; -> ["A" "B" "A_2"] By default, unique aliases are generated for each unique (unique-name-fn id original-name) for example: (let [unique-name (unique-name-generator)] [(unique-name :x "A") (unique-name :x "B") (unique-name :x "A") (unique-name :y "A")]) ;; -> ["A" "B" "A" "A_2"] Finally, [[unique-name-generator]] accepts the following options to further customize behavior: `:name-key-fn`Generated aliases are unique by the value of (let [f (unique-name-generator :name-key-fn str/lower-case)] [(f "x") (f "X") (f "X")]) ;; -> ["x" "X2" "X3"] This is useful for databases that treat column aliases as case-insensitive (see #19618 for some examples of this). `:unique-alias-fn`The function used to generate a potentially-unique alias given an original alias and unique suffix with the signature (unique-alias-fn original suffix) By default, combines them like (let [f (unique-name-generator :unique-alias-fn (fn [x y] (format "%s~~%s" y x)))] [(f "x") (f "x")]) ;; -> ["x" "2~~x"] This is useful if you need to constrain the generated suffix in some way, for example by limiting its length or escaping characters disallowed in a column alias. Values generated by this function are recursively checked for uniqueness, and will keep trying values a unique value is generated; for this reason the function must return a unique value for every unique input. Use caution when limiting the length of the identifier generated (consider appending a hash in cases like these). | (defn unique-name-generator
[& {:keys [name-key-fn unique-alias-fn]
:or {name-key-fn identity
unique-alias-fn (fn [original suffix]
(str original \_ suffix))}}]
(let [id+original->unique (atom {}) ; map of [id original-alias] -> unique-alias
original->count (atom {})] ; map of original-alias -> count
(fn generate-name
([alias]
(generate-name (gensym) alias))
([id original]
(let [name-key (name-key-fn original)]
(or
;; if we already have generated an alias for this key (e.g. `[id original]`), return it as-is.
(@id+original->unique [id name-key])
;; otherwise generate a new unique alias.
;; see if we're the first to try to use this candidate alias. Update the usage count in `original->count`
(let [total-count (get (swap! original->count update name-key (fnil inc 0)) name-key)]
(if (= total-count 1)
;; if we are the first to do it, record it in `id+original->unique` and return it.
(do
(swap! id+original->unique assoc [id name-key] original)
original)
;; otherwise prefix the alias by the current total count (e.g. `id` becomes `id_2`) and recur. If `id_2`
;; is unused, it will get returned. Otherwise we'll recursively try `id_2_2`, and so forth.
(let [candidate (unique-alias-fn original (str total-count))]
;; double-check that `unique-alias-fn` isn't doing something silly like truncating the generated alias
;; to aggressively or forgetting to include the `suffix` -- otherwise we could end up with an infinite
;; loop
(assert (not= candidate original)
(str "unique-alias-fn must return a different string than its input. Input: "
(pr-str candidate)))
(recur id candidate)))))))))) |
(mu/defn uniquify-names :- [:and
[:sequential :string]
[:fn
{:error/message "sequence of unique strings"}
distinct?]]
"Make the names in a sequence of string names unique by adding suffixes such as `_2`.
(uniquify-names [\"count\" \"sum\" \"count\" \"count_2\"])
;; -> [\"count\" \"sum\" \"count_2\" \"count_2_2\"]"
[names :- [:sequential :string]]
(map (unique-name-generator) names)) | |
(def ^:private NamedAggregation
[:and
mbql.s/aggregation-options
[:fn
{:error/message "`:aggregation-options` with a `:name`"}
#(:name (nth % 2))]]) | |
(def ^:private UniquelyNamedAggregations
[:and
[:sequential NamedAggregation]
[:fn
{:error/message "sequence of named aggregations with unique names"}
(fn [clauses]
(apply distinct? (for [[_tag _wrapped {ag-name :name}] clauses]
ag-name)))]]) | |
(mu/defn uniquify-named-aggregations :- UniquelyNamedAggregations
"Make the names of a sequence of named aggregations unique by adding suffixes such as `_2`."
[named-aggregations :- [:sequential NamedAggregation]]
(let [unique-names (uniquify-names
(for [[_ _wrapped-ag {ag-name :name}] named-aggregations]
ag-name))]
(map
(fn [[_ wrapped-ag options] unique-name]
[:aggregation-options wrapped-ag (assoc options :name unique-name)])
named-aggregations
unique-names))) | |
(mu/defn pre-alias-aggregations :- [:sequential NamedAggregation]
"Wrap every aggregation clause in an `:aggregation-options` clause, using the name returned
by `(aggregation->name-fn ag-clause)` as names for any clauses that do not already have a `:name` in
`:aggregation-options`.
(pre-alias-aggregations annotate/aggregation-name
[[:count] [:count] [:aggregation-options [:sum [:field 1 nil] {:name \"Sum-41\"}]])
;; -> [[:aggregation-options [:count] {:name \"count\"}]
[:aggregation-options [:count] {:name \"count\"}]
[:aggregation-options [:sum [:field 1 nil]] {:name \"Sum-41\"}]]
Most often, `aggregation->name-fn` will be something like `annotate/aggregation-name`, but for purposes of keeping
the `metabase.mbql` module seperate from the `metabase.query-processor` code we'll let you pass that in yourself."
{:style/indent 1}
[aggregation->name-fn :- fn?
aggregations :- [:sequential mbql.s/Aggregation]]
(mbql.match/replace aggregations
[:aggregation-options _ (_ :guard :name)]
&match
[:aggregation-options wrapped-ag options]
[:aggregation-options wrapped-ag (assoc options :name (aggregation->name-fn wrapped-ag))]
[(_ :guard keyword?) & _]
[:aggregation-options &match {:name (aggregation->name-fn &match)}])) | |
(mu/defn pre-alias-and-uniquify-aggregations :- UniquelyNamedAggregations
"Wrap every aggregation clause in a `:named` clause with a unique name. Combines `pre-alias-aggregations` with
`uniquify-named-aggregations`."
{:style/indent 1}
[aggregation->name-fn :- fn?
aggregations :- [:sequential mbql.s/Aggregation]]
(-> (pre-alias-aggregations aggregation->name-fn aggregations)
uniquify-named-aggregations)) | |
(defn- safe-min [& args]
(transduce
(filter some?)
(completing
(fn [acc n]
(if acc
(min acc n)
n)))
nil
args)) | |
Calculate the absolute maximum number of results that should be returned by this query (MBQL or native), useful for doing the equivalent of java.sql.Statement statement = ...;
statement.setMaxRows( to ensure the DB cursor or equivalent doesn't fetch more rows than will be consumed. This is calculated as follows:
| (defn query->max-rows-limit
[{{:keys [max-results max-results-bare-rows]} :constraints
{limit :limit, aggregations :aggregation, {:keys [items]} :page} :query
query-type :type}]
(let [mbql-limit (when (= query-type :query)
(safe-min items limit))
constraints-limit (or
(when-not aggregations
max-results-bare-rows)
max-results)]
(safe-min mbql-limit constraints-limit))) |
(defn- remove-empty [x]
(cond
(map? x)
(not-empty (into {} (for [[k v] x
:let [v (remove-empty v)]
:when (some? v)]
[k v])))
(sequential? x)
(not-empty (into (empty x) (filter some? (map remove-empty x))))
:else
x)) | |
(mu/defn update-field-options :- mbql.s/Reference
"Like [[clojure.core/update]], but for the options in a `:field`, `:expression`, or `:aggregation` clause."
{:arglists '([field-or-ag-ref-or-expression-ref f & args])}
[[clause-type id-or-name opts] :- mbql.s/Reference f & args]
(let [opts (not-empty (remove-empty (apply f opts args)))]
;; `:field` clauses should have a `nil` options map if there are no options. `:aggregation` and `:expression`
;; should get the arg removed if it's `nil` or empty. (For now. In the future we may change this if we make the
;; 3-arg versions the "official" normalized versions.)
(cond
opts [clause-type id-or-name opts]
(= clause-type :field) [clause-type id-or-name nil]
:else [clause-type id-or-name]))) | |
Like [[clojure.core/assoc]], but for the options in a | (defn assoc-field-options [clause & kvs] (apply update-field-options clause assoc kvs)) |
Set the | (defn with-temporal-unit
[[_ _ {:keys [base-type]} :as clause] unit]
;; it doesn't make sense to call this on an `:expression` or `:aggregation`.
(assert (is-clause? :field clause))
(if (or (not base-type)
(mbql.s/valid-temporal-unit-for-base-type? base-type unit))
(assoc-field-options clause :temporal-unit unit)
(do
(log/warn (i18n/tru "{0} is not a valid temporal unit for {1}; not adding to clause {2}"
unit base-type (pr-str clause)))
clause))) |
Update a | (defn remove-namespaced-options
[field-or-ref]
(update-field-options field-or-ref (partial into {} (remove (fn [[k _]]
(qualified-keyword? k)))))) |
Find all the | (defn referenced-field-ids
[coll]
(not-empty
(into #{}
(comp cat (filter some?))
(mbql.match/match coll
[:field (id :guard integer?) opts]
[id (:source-field opts)])))) |
Find the forms matching pred, returns a list of tuples of location (as used in get-in) and the match. | (defn matching-locations
[form pred]
(loop [stack [[[] form]], matches []]
(if-let [[loc form :as top] (peek stack)]
(let [stack (pop stack)
onto-stack #(into stack (map (fn [[k v]] [(conj loc k) v])) %)]
(cond
(pred form) (recur stack (conj matches top))
(map? form) (recur (onto-stack form) matches)
(sequential? form) (recur (onto-stack (map-indexed vector form)) matches)
:else (recur stack matches)))
matches))) |
#?(:clj
(p/import-vars
[mbql.match
match
match-one
replace
replace-in])) | |
Common utility functions useful throughout the codebase. | (ns metabase.util
(:require
[camel-snake-kebab.internals.macros :as csk.macros]
[clojure.data :refer [diff]]
[clojure.pprint :as pprint]
[clojure.set :as set]
[clojure.string :as str]
[clojure.walk :as walk]
[flatland.ordered.map :refer [ordered-map]]
[medley.core :as m]
[metabase.shared.util.i18n :refer [tru] :as i18n]
[metabase.shared.util.namespaces :as u.ns]
[metabase.util.format :as u.format]
[metabase.util.log :as log]
[metabase.util.memoize :as memoize]
[net.cgrand.macrovich :as macros]
[weavejester.dependency :as dep]
#?@(:clj ([clojure.math.numeric-tower :as math]
[me.flowthing.pp :as pp]
[metabase.config :as config]
#_{:clj-kondo/ignore [:discouraged-namespace]}
[metabase.util.jvm :as u.jvm]
[metabase.util.string :as u.str]
[potemkin :as p]
[ring.util.codec :as codec])))
#?(:clj (:import
(java.text Normalizer Normalizer$Form)
(java.util Locale)
(org.apache.commons.validator.routines RegexValidator UrlValidator)))
#?(:cljs (:require-macros [camel-snake-kebab.internals.macros :as csk.macros]
[metabase.util]))) |
(u.ns/import-fns [u.format colorize format-bytes format-color format-milliseconds format-nanoseconds format-seconds]) | |
#?(:clj (p/import-vars [u.jvm
all-ex-data
auto-retry
decode-base64
decode-base64-to-bytes
deref-with-timeout
encode-base64
filtered-stacktrace
full-exception-chain
generate-nano-id
host-port-up?
host-up?
ip-address?
metabase-namespace-symbols
sorted-take
varargs
with-timeout
with-us-locale]
[u.str
build-sentence])) | |
Like or, but determines truthiness with | (defmacro or-with
{:style/indent 1}
[pred & more]
(reduce (fn [inner value]
`(let [value# ~value]
(if (~pred value#)
value#
~inner)))
nil
(reverse more))) |
Simple macro which wraps the given expression in a try/catch block and ignores the exception if caught. | (defmacro ignore-exceptions
{:style/indent 0}
[& body]
`(try ~@body (catch ~(macros/case
:cljs 'js/Error
:clj 'Throwable)
~'_))) |
Execute (def numbers (atom [])) (defn find-or-add [n] (or (first-index-satisfying (partial = n) @numbers) (prog1 (count @numbers) (swap! numbers conj n)))) (find-or-add 100) -> 0 (find-or-add 200) -> 1 (find-or-add 100) -> 0 The result of (prog1 (some-expression) (println "RESULTS:" <>))
Style note: Prefer TODO -- maybe renaming this to | (defmacro prog1
{:style/indent :defn}
[first-form & body]
`(let [~'<> ~first-form]
~@body
~'<>)) |
Takes a message string and returns a basic exception: [[java.lang.Exception]] on JVM and [[Error]] in JS. | (defn error
[^String msg]
#?(:clj (Exception. msg)
:cljs (js/Error. msg))) |
Return (u/qualified-name :type/FK) -> "type/FK" | (defn qualified-name
[k]
(when (some? k)
(if-let [namespac (when #?(:clj (instance? clojure.lang.Named k)
:cljs (satisfies? INamed k))
(namespace k))]
(str namespac "/" (name k))
(name k)))) |
Given a map, returns a new map with all nil values removed. | (defn remove-nils [m] (m/filter-vals some? m)) |
Recursively replace the keys in a map with the value of | (defn recursive-map-keys
[f m]
(walk/postwalk
#(if (map? %)
(m/map-keys f %)
%)
m)) |
Fixes strings that don't terminate in a period; also accounts for strings
that end in | (defn add-period
[s]
(let [text (str s)]
(if (or (str/blank? text)
(#{\. \? \!} (last text)))
text
(if (str/ends-with? text ":")
(str (subs text 0 (- (count text) 1)) ".")
(str text "."))))) |
Locale-agnostic version of [[clojure.string/lower-case]]. [[clojure.string/lower-case]] uses the default locale in
conversions, turning | (defn lower-case-en
^String [s]
(when s
#?(:clj (.toLowerCase (str s) (Locale/US))
:cljs (.toLowerCase (str s))))) |
Locale-agnostic version of | (defn upper-case-en
^String [s]
(when s
#?(:clj (.toUpperCase (str s) (Locale/US))
:cljs (.toUpperCase (str s))))) |
Locale-agnostic version of [[clojure.string/capitalize]]. | (defn capitalize-en
^String [^CharSequence s]
(when-let [s (some-> s str)]
(if (< (count s) 2)
(upper-case-en s)
(str (upper-case-en (subs s 0 1))
(lower-case-en (subs s 1)))))) |
define custom CSK conversion functions so we don't run into problems if the system locale is Turkish | |
so Kondo doesn't complain | (declare ^:private ->kebab-case-en*) (declare ^:private ->camelCaseEn*) (declare ^:private ->snake_case_en*) (declare ^:private ->SCREAMING_SNAKE_CASE_EN*) |
(csk.macros/defconversion "kebab-case-en*" lower-case-en lower-case-en "-") (csk.macros/defconversion "camelCaseEn*" lower-case-en capitalize-en "") (csk.macros/defconversion "snake_case_en*" lower-case-en lower-case-en "_") (csk.macros/defconversion "SCREAMING_SNAKE_CASE_EN*" upper-case-en upper-case-en "_") | |
Wrap a CSK defconversion function so that it handles nil and namespaced keywords, which it doesn't support out of the box for whatever reason. | (defn- wrap-csk-conversion-fn-to-handle-nil-and-namespaced-keywords
[f]
(fn [x]
(when x
(if (qualified-keyword? x)
(keyword (f (namespace x)) (f (name x)))
(f x))))) |
Like [[camel-snake-kebab.core/->kebab-case]], but always uses English for lower-casing, supports keywords with
namespaces, and returns | (def ^{:arglists '([x])} ->kebab-case-en
(memoize/lru (wrap-csk-conversion-fn-to-handle-nil-and-namespaced-keywords ->kebab-case-en*) :lru/threshold 256)) |
Like [[camel-snake-kebab.core/->snake_case]], but always uses English for lower-casing, supports keywords with
namespaces, and returns | (def ^{:arglists '([x])} ->snake_case_en
(memoize/lru (wrap-csk-conversion-fn-to-handle-nil-and-namespaced-keywords ->snake_case_en*) :lru/threshold 256)) |
Like [[camel-snake-kebab.core/->camelCase]], but always uses English for upper- and lower-casing, supports keywords
with namespaces, and returns | (def ^{:arglists '([x])} ->camelCaseEn
(memoize/lru (wrap-csk-conversion-fn-to-handle-nil-and-namespaced-keywords ->camelCaseEn*) :lru/threshold 256)) |
Like [[camel-snake-kebab.core/->SCREAMINGSNAKECASE]], but always uses English for upper- and lower-casing, supports
keywords with namespaces, and returns | (def ^{:arglists '([x])} ->SCREAMING_SNAKE_CASE_EN
(memoize/lru (wrap-csk-conversion-fn-to-handle-nil-and-namespaced-keywords ->SCREAMING_SNAKE_CASE_EN*)
:lru/threshold 256)) |
Like string/capitalize, only it ignores the rest of the string to retain case-sensitive capitalization, e.g., PostgreSQL. | (defn capitalize-first-char
[s]
(if (< (count s) 2)
(upper-case-en s)
(str (upper-case-en (subs s 0 1))
(subs s 1)))) |
Convert the keys in a map from | (defn snake-keys [m] (recursive-map-keys ->snake_case_en m)) |
Given any map-like object, return it as a Clojure map with :kebab-case keyword keys.
The input map can be a:
- Clojure map with string or keyword keys,
- JS object (with string keys)
The keys are converted to Returns an empty map if nil is input (like [[update-keys]]). | (defn normalize-map
[m]
(let [base #?(:clj m
;; If we're running in CLJS, convert to a ClojureScript map as needed.
:cljs (if (object? m)
(js->clj m)
m))]
(update-keys base (comp keyword ->kebab-case-en)))) |
Log the maximum memory available to the JVM at launch time as well since it is very handy for debugging things | #?(:clj
(when-not *compile-files*
(log/info (i18n/trs "Maximum memory available to JVM: {0}" (u.format/format-bytes (.maxMemory (Runtime/getRuntime))))))) |
Set the default width for pprinting to 120 instead of 72. The default width is too narrow and wastes a lot of space | #?(:clj (alter-var-root #'pprint/*print-right-margin* (constantly 120)) :cljs (set! pprint/*print-right-margin* (constantly 120))) |
Is | (defn email?
^Boolean [^String s]
(boolean (when (string? s)
(re-matches #"[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?"
(lower-case-en s))))) |
Is | (defn state?
^Boolean [s]
(boolean
(when (string? s)
(contains? #{"alabama" "alaska" "arizona" "arkansas" "california" "colorado" "connecticut" "delaware"
"florida" "georgia" "hawaii" "idaho" "illinois" "indiana" "iowa" "kansas" "kentucky" "louisiana"
"maine" "maryland" "massachusetts" "michigan" "minnesota" "mississippi" "missouri" "montana"
"nebraska" "nevada" "new hampshire" "new jersey" "new mexico" "new york" "north carolina"
"north dakota" "ohio" "oklahoma" "oregon" "pennsylvania" "rhode island" "south carolina"
"south dakota" "tennessee" "texas" "utah" "vermont" "virginia" "washington" "west virginia"
"wisconsin" "wyoming"
"ak" "al" "ar" "az" "ca" "co" "ct" "de" "fl" "ga" "hi" "ia" "id" "il" "in" "ks" "ky" "la"
"ma" "md" "me" "mi" "mn" "mo" "ms" "mt" "nc" "nd" "ne" "nh" "nj" "nm" "nv" "ny" "oh" "ok"
"or" "pa" "ri" "sc" "sd" "tn" "tx" "ut" "va" "vt" "wa" "wi" "wv" "wy"}
(lower-case-en s))))) |
(def ^:private ^String url-regex-pattern
(let [alpha #?(:clj "IsAlphabetic" :cljs "Alphabetic")]
(str "^[\\p{" alpha "}\\d_\\-]+(\\.[\\p{" alpha "}\\d_\\-]+)*(:\\d*)?"))) | |
Is | (defn url?
^Boolean [s]
#?(:clj (let [validator (UrlValidator. (u.jvm/varargs String ["http" "https"])
(RegexValidator. url-regex-pattern)
UrlValidator/ALLOW_LOCAL_URLS)]
(.isValid validator (str s)))
:cljs (try
(let [url (js/URL. (str s))]
(boolean (and (re-matches (js/RegExp. url-regex-pattern "u")
(.-host url))
(#{"http:" "https:"} (.-protocol url)))))
(catch js/Error _
false)))) |
Returns (string? nil) -> false (string? "A") -> true (maybe? string? nil) -> true (maybe? string? "A") -> true It can also be used to make sure a given function won't throw a (str/lower-case nil) -> NullPointerException (str/lower-case "ABC") -> "abc" (maybe? str/lower-case nil) -> true (maybe? str/lower-case "ABC") -> "abc" The latter use-case can be useful for things like sorting where some values in a collection
might be (sort-by (partial maybe? s/lower-case) some-collection) | (defn maybe?
[f x]
(or (nil? x)
(f x))) |
Returns the | (def ^String ^{:arglists '([emoji-string])} emoji
#?(:clj (if (config/config-bool :mb-emoji-in-logs)
identity
(constantly ""))
:cljs (constantly ""))) |
Round (presumabily floating-point) Rounds by decimal places, no matter how many significant figures the number has. See [[round-to-precision]]. (round-to-decimals 2 35.5058998M) -> 35.51 | (defn round-to-decimals
^Double [^Integer decimal-place, ^Number number]
{:pre [(integer? decimal-place) (number? number)]}
#?(:clj (double (.setScale (bigdec number) decimal-place BigDecimal/ROUND_HALF_UP))
:cljs (parse-double (.toFixed number decimal-place)))) |
Is | (defn real-number?
[x]
(and (number? x)
(not (NaN? x))
(not (infinite? x)))) |
Return a version of | (defn remove-diacritical-marks
^String [^String s]
(when (seq s)
#?(:clj (str/replace
;; First, "decompose" the characters. e.g. replace 'LATIN CAPITAL LETTER A WITH ACUTE' with
;; 'LATIN CAPITAL LETTER A' + 'COMBINING ACUTE ACCENT'
;; See http://docs.oracle.com/javase/8/docs/api/java/text/Normalizer.html
(Normalizer/normalize s Normalizer$Form/NFD)
;; next, remove the combining diacritical marks -- this SO answer explains what's going on here best:
;; http://stackoverflow.com/a/5697575/1198455 The closest thing to a relevant JavaDoc I could find was
;; http://docs.oracle.com/javase/7/docs/api/java/lang/Character.UnicodeBlock.html#COMBINING_DIACRITICAL_MARKS
#"\p{Block=CombiningDiacriticalMarks}+"
"")
:cljs (-> s
(.normalize "NFKD") ;; Renders accented characters as base + accent.
(.replace (js/RegExp. "[\u0300-\u036f]" "gu") ""))))) ;; Drops all the accents. |
Drops all the accents. | |
Valid ASCII characters for URL slugs generated by | (def ^:private slugify-valid-chars
#{\a \b \c \d \e \f \g \h \i \j \k \l \m \n \o \p \q \r \s \t \u \v \w \x \y \z
\0 \1 \2 \3 \4 \5 \6 \7 \8 \9
\_}) |
unfortunately it seems that this doesn't fully-support Emoji :(, they get encoded as "??" | (defn- slugify-char [^Character c url-encode?]
(if (< #?(:clj (int c) :cljs (.charCodeAt c 0))
128)
;; ASCII characters must be in the valid list, or they get replaced with underscores.
(if (contains? slugify-valid-chars c)
c
\_)
;; Non-ASCII characters are URL-encoded or preserved, based on the option.
(if url-encode?
#?(:clj (codec/url-encode c)
:cljs (js/encodeURIComponent c))
c))) |
Return a version of String If Optionally specify | (defn slugify
(^String [^String s]
(slugify s {}))
(^String [s {:keys [max-length unicode?]}]
(when (seq s)
(let [slug (str/join (for [c (remove-diacritical-marks (lower-case-en s))]
(slugify-char c (not unicode?))))]
(if max-length
(str/join (take max-length slug))
slug))))) |
If passed an integer ID, returns it. If passed a map containing an Provided as a convenience to allow model-layer functions to easily accept either an object or raw ID. Use this in
cases where the ID/object is allowed to be | (defn id
^Integer [object-or-id]
(cond
(map? object-or-id) (recur (:id object-or-id))
(integer? object-or-id) object-or-id)) |
If passed an integer ID, returns it. If passed a map containing an Provided as a convenience to allow model-layer functions to easily accept either an object or raw ID, and to assert that you have a valid ID. | (defn the-id
;; TODO - lots of functions can be rewritten to use this, which would make them more flexible
^Integer [object-or-id]
(or (id object-or-id)
(throw (error (tru "Not something with an ID: {0}" (pr-str object-or-id)))))) |
A regular expression for matching canonical string representations of UUIDs. | (def ^java.util.regex.Pattern uuid-regex
#"[a-f0-9]{8}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{12}") |
Wraps a single element in a sequence; returns sequences as-is. In lots of situations we'd like to accept either a single value or a collection of values as an argument to a function, and then loop over them; rather than repeat logic to check whether something is a collection and wrap if not everywhere, this utility function is provided for your convenience. (u/one-or-many 1) ; -> [1] (u/one-or-many [1 2]) ; -> [1 2] | (defn one-or-many
[arg]
(if ((some-fn sequential? set? nil?) arg)
arg
[arg])) |
Returns coll if it has multiple elements, or else returns its only element | (defn many-or-one
[coll]
(if (next coll)
coll
(first coll))) |
Like (select-nested-keys {:a 100, :b {:c 200, :d 300}} [:a [:b :d] :c]) ;; -> {:a 100, :b {:d 300}} The values of | (defn select-nested-keys
[m keyseq]
;; TODO - use (empty m) once supported by model instances
(into {} (for [k keyseq
:let [[k & nested-keys] (one-or-many k)
v (get m k)]
:when (contains? m k)]
{k (if-not (seq nested-keys)
v
(select-nested-keys v nested-keys))}))) |
Is | (defn base64-string?
^Boolean [s]
(boolean (when (string? s)
(as-> s s
(str/replace s #"\s" "")
(re-matches #"^(?:[A-Za-z0-9+/]{4})*(?:[A-Za-z0-9+/]{2}==|[A-Za-z0-9+/]{3}=)?$" s))))) |
Returns coll split into seqs of up to n items | (defn batches-of [n coll] (partition n n nil coll)) |
Increment | (def ^{:arglists '([n])} safe-inc
(fnil inc 0)) |
Like (select-non-nil-keys {:a 100, :b nil} #{:a :b :c}) ;; -> {:a 100} | (defn select-non-nil-keys
[m ks]
(into {} (for [k ks
:when (some? (get m k))]
{k (get m k)}))) |
Returns a map that only contains keys that are either (select-keys-when {:a 100, :b nil, :d 200, :e nil} :present #{:a :b :c} :non-nil #{:d :e :f}) ;; -> {:a 100, :b nil, :d 200} | (defn select-keys-when
{:style/indent 1}
[m & {:keys [present non-nil], :as options}]
{:pre [(every? #{:present :non-nil} (keys options))]}
(merge (select-keys m present)
(select-non-nil-keys m non-nil))) |
Return the order of magnitude as a power of 10 of a given number. | (defn order-of-magnitude
[x]
(if (zero? x)
0
#?(:clj (long (math/floor (/ (Math/log (math/abs x))
(Math/log 10))))
:cljs (js/Math.floor (/ (js/Math.log (abs x))
(js/Math.log 10)))))) |
Like | (defn update-if-exists
[m k f & args]
(if (contains? m k)
(apply update m k f args)
m)) |
Like | (defn update-in-if-exists
[m ks f & args]
(if (not= ::not-found (get-in m ks ::not-found))
(apply update-in m ks f args)
m)) |
Return index of the first element in | (defn index-of
[pred coll]
(first (keep-indexed (fn [i x]
(when (pred x) i))
coll))) |
Returns truthy if | (defn hexadecimal-string?
[new-value]
(and (string? new-value)
(re-matches #"[0-9a-f]{64}" new-value))) |
Topologically sorts vertexs in graph g. Graph is a map of vertexs to edges. Optionally takes an
additional argument Say you have a graph shaped like: a b | \ | c | | \ | / d | e (u/topological-sort identity {:b [] :c [:a] :e [:d] :d [:a :b :c] :a []}) => (ordered-map :a [] :b [] :c [:a] :d [:a :b :c] :e [:d]) If the graph has cycles, throws an exception. https://en.wikipedia.org/wiki/Topological_sorting | (defn topological-sort
"Topologically sorts vertexs in graph g. Graph is a map of vertexs to edges. Optionally takes an
additional argument `edges-fn`, a function used to extract edges. Returns data in the same shape
(a graph), only sorted.
Say you have a graph shaped like:
a b
| \\ |
c | |
\\ | /
d
|
e
(u/topological-sort identity {:b []
:c [:a]
:e [:d]
:d [:a :b :c]
:a []})
=> (ordered-map :a [] :b [] :c [:a] :d [:a :b :c] :e [:d])
If the graph has cycles, throws an exception.
https://en.wikipedia.org/wiki/Topological_sorting"
([g] (topological-sort identity g))
([edges-fn g]
(transduce (map (juxt key (comp edges-fn val)))
(fn
([] (dep/graph))
([acc [vertex edges]]
(reduce (fn [acc edge]
(dep/depend acc vertex edge))
acc
edges))
([acc]
(let [sorted (filter g (dep/topo-sort acc))
independent (set/difference (set (keys g)) (set sorted))]
(not-empty
(into (ordered-map)
(map (fn [vertex]
[vertex (g vertex)]))
(concat independent sorted))))))
g))) |
Changes the keys of a given map to lower case. | (defn lower-case-map-keys [m] (update-keys m #(-> % name lower-case-en keyword))) |
Returns the output of pretty-printing (pprint-to-str 'green some-obj) | (defn pprint-to-str
(^String [x]
(#?@
(:clj
(with-out-str
#_{:clj-kondo/ignore [:discouraged-var]}
(pp/pprint x {:max-width 120}))
:cljs
;; we try to set this permanently above, but it doesn't seem to work in Cljs, so just bind it every time. The
;; default value wastes too much space, 120 is a little easier to read actually.
(binding [pprint/*print-right-margin* 120]
(with-out-str
#_{:clj-kondo/ignore [:discouraged-var]}
(pprint/pprint x))))))
(^String [color-symb x]
(u.format/colorize color-symb (pprint-to-str x)))) |
Impl for | (def ^:dynamic *profile-level* 0) |
Impl for [[profile]] macro -- don't use this directly. Prints the | #_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
(defn -profile-print-time
[message-thunk start-time]
;; indent the message according to [[*profile-level*]] and add a little down-left arrow so it (hopefully) points to
;; the parent form
(log/info (u.format/format-color
(case (int (mod *profile-level* 4))
0 :green
1 :cyan
2 :magenta
3 :yellow) "%s%s took %s"
(if (pos? *profile-level*)
(str (str/join (repeat (dec *profile-level*) " ")) " ⮦ ")
"")
(message-thunk)
(u.format/format-nanoseconds (- #?(:cljs (* 1000000 (js/performance.now))
:clj (System/nanoTime))
start-time))))) |
Like [[clojure.core/time]], but lets you specify a (profile "top-level" (Thread/sleep 500) (profile "nested" (Thread/sleep 100))) ;; -> ↙ nested took 100.1 ms top-level took 602.8 ms | (defmacro profile
{:style/indent 1}
([form]
`(profile ~(str form) ~form))
([message & body]
;; message is wrapped in a thunk so we don't incur the overhead of calculating it if the log level does not include
;; INFO
`(let [message# (fn [] ~message)
start-time# ~(if (:ns &env)
`(* 1000000 (js/performance.now)) ;; CLJS
`(System/nanoTime)) ;; CLJ
result# (binding [*profile-level* (inc *profile-level*)]
~@body)]
(-profile-print-time message# start-time#)
result#))) |
Convert | (defn seconds->ms [seconds] (* seconds 1000)) |
Convert | (defn minutes->seconds [minutes] (* 60 minutes)) |
Convert | (defn minutes->ms [minutes] (-> minutes minutes->seconds seconds->ms)) |
Convert | (defn hours->ms [hours] (-> (* 60 hours) minutes->seconds seconds->ms)) |
Parse a currency String to a BigDecimal. Handles a variety of different formats, such as: $1,000.00 -£127.54 -127,54 € kr-127,54 € 127,54- ¥200 | (defn parse-currency
^java.math.BigDecimal [^String s]
(when-not (str/blank? s)
(#?(:clj bigdec :cljs js/parseFloat)
(reduce
(partial apply str/replace)
s
[;; strip out any current symbols
[#"[^\d,.-]+" ""]
;; now strip out any thousands separators
[#"(?<=\d)[,.](\d{3})" "$1"]
;; now replace a comma decimal seperator with a period
[#"," "."]
;; move minus sign at end to front
[#"(^[^-]+)-$" "-$1"]])))) |
Extract the domain portion of an (email->domain "cam@toucan.farm") ; -> "toucan.farm" | (defn email->domain
^String [email-address]
(when (string? email-address)
(last (re-find #"^.*@(.*$)" email-address)))) |
Is (email-in-domain? "cam@toucan.farm" "toucan.farm") ; -> true (email-in-domain? "cam@toucan.farm" "metabase.com") ; -> false | (defn email-in-domain?
[email-address domain]
{:pre [(email? email-address)]}
(= (email->domain email-address) domain)) |
Returns a pair [match others] where match is the first element of | (defn pick-first
[pred coll]
(loop [xs (seq coll), prefix []]
(when-let [[x & xs] xs]
(if (pred x)
[x (concat prefix xs)]
(recur xs (conj prefix x)))))) |
Clj doesn't have | #?(:clj (defn- regexp? [x]
(instance? java.util.regex.Pattern x))) |
(derive :dispatch-type/nil :dispatch-type/*) (derive :dispatch-type/boolean :dispatch-type/*) (derive :dispatch-type/string :dispatch-type/*) (derive :dispatch-type/keyword :dispatch-type/*) (derive :dispatch-type/number :dispatch-type/*) (derive :dispatch-type/integer :dispatch-type/number) (derive :dispatch-type/map :dispatch-type/*) (derive :dispatch-type/sequential :dispatch-type/*) (derive :dispatch-type/set :dispatch-type/*) (derive :dispatch-type/symbol :dispatch-type/*) (derive :dispatch-type/fn :dispatch-type/*) (derive :dispatch-type/regex :dispatch-type/*) | |
In Cljs This function exists as a workaround: use it as a multimethod dispatch function for Cljc multimethods that would
have dispatched on Returns Think of | (defn dispatch-type-keyword
[x]
(cond
(nil? x) :dispatch-type/nil
(boolean? x) :dispatch-type/boolean
(string? x) :dispatch-type/string
(keyword? x) :dispatch-type/keyword
(integer? x) :dispatch-type/integer
(number? x) :dispatch-type/number
(map? x) :dispatch-type/map
(sequential? x) :dispatch-type/sequential
(set? x) :dispatch-type/set
(symbol? x) :dispatch-type/symbol
(fn? x) :dispatch-type/fn
(regexp? x) :dispatch-type/regex
;; we should add more mappings here as needed
:else :dispatch-type/*)) |
Called like Put another way: Note that if | (defn assoc-dissoc
[m k v]
(if (some? v)
(assoc m k v)
(dissoc m k))) |
Called like | (defn assoc-default
([m k v]
(if (or (nil? v) (contains? m k))
m
(assoc m k v)))
([m k v & kvs]
(let [ret (assoc-default m k v)]
(if kvs
(if (next kvs)
(recur ret (first kvs) (second kvs) (nnext kvs))
(throw (ex-info "assoc-default expects an even number of key-values"
{:kvs kvs})))
ret)))) |
Given 2 lists of seq maps of changes, where each map an has an Where:
:to-create is a list of maps that ids in | (defn classify-changes
[current-items new-items]
(let [[delete-ids create-ids update-ids] (diff (set (map :id current-items))
(set (map :id new-items)))]
{:to-create (when (seq create-ids) (filter #(create-ids (:id %)) new-items))
:to-delete (when (seq delete-ids) (filter #(delete-ids (:id %)) current-items))
:to-update (when (seq update-ids) (filter #(update-ids (:id %)) new-items))})) |
True if collection | (defn empty-or-distinct?
[xs]
(or (empty? xs)
(apply distinct? xs))) |
Traverses a graph of nodes using a user-defined function.
The function performs a breadth-first traversal starting from the initial nodes, applying
| (defn traverse
[nodes traverse-fn]
(loop [to-traverse (set nodes)
traversed #{}]
(let [item (first to-traverse)
found (traverse-fn item)
traversed (conj traversed item)
to-traverse (set/union (disj to-traverse item) (set/difference found traversed))]
(if (empty? to-traverse)
traversed
(recur to-traverse traversed))))) |
(ns metabase.lib.util
(:refer-clojure :exclude [format])
(:require
#?@(:clj
([potemkin :as p]))
#?@(:cljs
(["crc-32" :as CRC32]
[goog.string :as gstring]
[goog.string.format :as gstring.format]))
[clojure.set :as set]
[clojure.string :as str]
[medley.core :as m]
[metabase.lib.common :as lib.common]
[metabase.lib.dispatch :as lib.dispatch]
[metabase.lib.hierarchy :as lib.hierarchy]
[metabase.lib.options :as lib.options]
[metabase.lib.schema :as lib.schema]
[metabase.lib.schema.common :as lib.schema.common]
[metabase.lib.schema.expression :as lib.schema.expression]
[metabase.lib.schema.id :as lib.schema.id]
[metabase.lib.schema.ref :as lib.schema.ref]
[metabase.mbql.util :as mbql.u]
[metabase.shared.util.i18n :as i18n]
[metabase.util :as u]
[metabase.util.malli :as mu])) | |
#?(:clj (set! *warn-on-reflection* true)) | |
The formatting functionality is only loaded if you depend on goog.string.format. | #?(:cljs (comment gstring.format/keep-me)) ;;; For convenience: [[metabase.lib.util/format]] maps to [[clojure.core/format]] in Clj and [[goog.string/format]] in ;;; Cljs. They both work like [[clojure.core/format]], but since that doesn't exist in Cljs, you can use this instead. #?(:clj (p/import-vars [clojure.core format]) :cljs (def format "Exactly like [[clojure.core/format]] but ClojureScript-friendly." gstring/format)) |
Returns true if this is a clause. | (defn clause?
[clause]
(and (vector? clause)
(keyword? (first clause))
(let [opts (get clause 1)]
(and (map? opts)
(contains? opts :lib/uuid))))) |
Returns true if this is a clause. | (defn clause-of-type?
[clause clause-type]
(and (clause? clause)
(= (first clause) clause-type))) |
Returns true if this is a field clause. | (defn field-clause? [clause] (clause-of-type? clause :field)) |
Returns true if this is any sort of reference clause | (defn ref-clause?
[clause]
(and (clause? clause)
(lib.hierarchy/isa? (first clause) ::lib.schema.ref/ref))) |
Returns whether the type of | (defn original-isa?
[expression typ]
(isa?
(or (and (clause? expression)
(:metabase.lib.field/original-effective-type (second expression)))
(lib.schema.expression/type-of expression))
typ)) |
Returns the :lib/expression-name of | (defn expression-name
[clause]
(when (clause? clause)
(:lib/expression-name (lib.options/options clause)))) |
Top level expressions must be clauses with :lib/expression-name, so if we get a literal, wrap it in :value. | (defn top-level-expression-clause
[clause a-name]
(-> (if (clause? clause)
clause
[:value {:lib/uuid (str (random-uuid))
:effective-type (lib.schema.expression/type-of clause)}
clause])
(lib.options/update-options (fn [opts]
(-> opts
(assoc :lib/expression-name a-name)
(dissoc :name :display-name)))))) |
Implementation for [[custom-name]]. | (defmulti custom-name-method
{:arglists '([x])}
lib.dispatch/dispatch-value
:hierarchy lib.hierarchy/hierarchy) |
Return the user supplied name of | (defn custom-name [x] (custom-name-method x)) |
(defmethod custom-name-method :default
[x]
;; We assume that clauses only get a :display-name option if the user explicitly specifies it.
;; Expressions from the :expressions clause of pMBQL queries have custom names by default.
(when (clause? x)
((some-fn :display-name :lib/expression-name) (lib.options/options x)))) | |
Replace the | (defn replace-clause
[stage location target-clause new-clause]
{:pre [((some-fn clause? #(= (:lib/type %) :mbql/join)) target-clause)]}
(let [new-clause (if (= :expressions (first location))
(top-level-expression-clause new-clause (or (custom-name new-clause)
(expression-name target-clause)))
new-clause)]
(m/update-existing-in
stage
location
(fn [clause-or-clauses]
(->> (for [clause clause-or-clauses]
(if (= (lib.options/uuid clause) (lib.options/uuid target-clause))
new-clause
clause))
vec))))) |
Remove the | (defn remove-clause
[stage location target-clause stage-number]
{:pre [(clause? target-clause)]}
(if-let [target (get-in stage location)]
(let [target-uuid (lib.options/uuid target-clause)
[first-loc last-loc] [(first location) (last location)]
result (into [] (remove (comp #{target-uuid} lib.options/uuid)) target)
result (when-not (and (= location [:fields])
(every? #(clause-of-type? % :expression) result))
result)]
(cond
(seq result)
(assoc-in stage location result)
(= [:joins :conditions] [first-loc last-loc])
(throw (ex-info (i18n/tru "Cannot remove the final join condition")
{:error ::cannot-remove-final-join-condition
:conditions (get-in stage location)
:join (get-in stage (pop location))
:stage-number stage-number
:stage stage}))
(= [:joins :fields] [first-loc last-loc])
(update-in stage (pop location) dissoc last-loc)
:else
(m/dissoc-in stage location)))
stage)) |
TODO -- all of this | |
Convert a | (defn- native-query->pipeline
[query]
(merge {:lib/type :mbql/query
;; we're using `merge` here instead of threading stuff so the `:lib/` keys are the first part of the map for
;; readability in the REPL.
:stages [(merge {:lib/type :mbql.stage/native}
(set/rename-keys (:native query) {:query :native}))]}
(dissoc query :type :native))) |
(declare inner-query->stages) | |
Updates m with a legacy boolean expression at | (defn- update-legacy-boolean-expression->list
[m legacy-key pMBQL-key]
(cond-> m
(contains? m legacy-key) (update legacy-key #(if (and (vector? %)
(= (first %) :and))
(vec (drop 1 %))
[%]))
(contains? m legacy-key) (set/rename-keys {legacy-key pMBQL-key}))) |
(defn- join->pipeline [join]
(let [source (select-keys join [:source-table :source-query])
stages (inner-query->stages source)]
(-> join
(dissoc :source-table :source-query)
(update-legacy-boolean-expression->list :condition :conditions)
(assoc :lib/type :mbql/join
:stages stages)
lib.options/ensure-uuid))) | |
(defn- joins->pipeline [joins] (mapv join->pipeline joins)) | |
Convert legacy | (defn ->stage-metadata
[source-metadata]
(when source-metadata
(-> (if (seqable? source-metadata)
{:columns source-metadata}
source-metadata)
(update :columns (fn [columns]
(mapv (fn [column]
(-> column
(update-keys u/->kebab-case-en)
(assoc :lib/type :metadata/column)))
columns)))
(assoc :lib/type :metadata/results)))) |
(defn- inner-query->stages [{:keys [source-query source-metadata], :as inner-query}]
(let [previous-stages (if source-query
(inner-query->stages source-query)
[])
source-metadata (->stage-metadata source-metadata)
previous-stage (dec (count previous-stages))
previous-stages (cond-> previous-stages
(and source-metadata
(not (neg? previous-stage))) (assoc-in [previous-stage :lib/stage-metadata] source-metadata))
stage-type (if (:native inner-query)
:mbql.stage/native
:mbql.stage/mbql)
;; we're using `merge` here instead of threading stuff so the `:lib/` keys are the first part of the map for
;; readability in the REPL.
this-stage (merge {:lib/type stage-type}
(dissoc inner-query :source-query :source-metadata))
this-stage (cond-> this-stage
(seq (:joins this-stage)) (update :joins joins->pipeline)
:always (update-legacy-boolean-expression->list :filter :filters))]
(conj previous-stages this-stage))) | |
Convert a | (defn- mbql-query->pipeline
[query]
(merge {:lib/type :mbql/query
:stages (inner-query->stages (:query query))}
(dissoc query :type :query))) |
Schema for a map that is either a legacy query OR a pMBQL query. | (def LegacyOrPMBQLQuery
[:or
[:map
{:error/message "legacy query"}
[:type [:enum :native :query]]]
[:map
{:error/message "pMBQL query"}
[:lib/type [:= :mbql/query]]]]) |
Ensure that a | (mu/defn pipeline
[query :- LegacyOrPMBQLQuery]
(if (= (:lib/type query) :mbql/query)
query
(case (:type query)
:native (native-query->pipeline query)
:query (mbql-query->pipeline query)))) |
(mu/defn canonical-stage-index :- [:int {:min 0}]
"If `stage-number` index is a negative number e.g. `-1` convert it to a positive index so we can use `nth` on
`stages`. `-1` = the last stage, `-2` = the penultimate stage, etc."
[{:keys [stages], :as _query} :- :map
stage-number :- :int]
(let [stage-number' (if (neg? stage-number)
(+ (count stages) stage-number)
stage-number)]
(when (or (>= stage-number' (count stages))
(neg? stage-number'))
(throw (ex-info (i18n/tru "Stage {0} does not exist" stage-number)
{:num-stages (count stages)})))
stage-number')) | |
(mu/defn previous-stage-number :- [:maybe [:int {:min 0}]]
"The index of the previous stage, if there is one. `nil` if there is no previous stage."
[query :- :map
stage-number :- :int]
(let [stage-number (canonical-stage-index query stage-number)]
(when (pos? stage-number)
(dec stage-number)))) | |
Whether a | (defn first-stage? [query stage-number] (not (previous-stage-number query stage-number))) |
(mu/defn next-stage-number :- [:maybe :int]
"The index of the next stage, if there is one. `nil` if there is no next stage."
[{:keys [stages], :as _query} :- :map
stage-number :- :int]
(let [stage-number (if (neg? stage-number)
(+ (count stages) stage-number)
stage-number)]
(when (< (inc stage-number) (count stages))
(inc stage-number)))) | |
(mu/defn query-stage :- [:maybe ::lib.schema/stage]
"Fetch a specific `stage` of a query. This handles negative indices as well, e.g. `-1` will return the last stage of
the query."
[query :- LegacyOrPMBQLQuery
stage-number :- :int]
(let [{:keys [stages], :as query} (pipeline query)]
(get (vec stages) (canonical-stage-index query stage-number)))) | |
(mu/defn previous-stage :- [:maybe ::lib.schema/stage]
"Return the previous stage of the query, if there is one; otherwise return `nil`."
[query stage-number :- :int]
(when-let [stage-num (previous-stage-number query stage-number)]
(query-stage query stage-num))) | |
(mu/defn update-query-stage :- ::lib.schema/query
"Update a specific `stage-number` of a `query` by doing
(apply f stage args)
`stage-number` can be a negative index, e.g. `-1` will update the last stage of the query."
[query :- LegacyOrPMBQLQuery
stage-number :- :int
f & args]
(let [{:keys [stages], :as query} (pipeline query)
stage-number' (canonical-stage-index query stage-number)
stages' (apply update (vec stages) stage-number' f args)]
(assoc query :stages stages'))) | |
(mu/defn ensure-mbql-final-stage :- ::lib.schema/query
"Convert query to a pMBQL (pipeline) query, and make sure the final stage is an `:mbql` one."
[query]
(let [query (pipeline query)]
(cond-> query
(= (:lib/type (query-stage query -1)) :mbql.stage/native)
(update :stages conj {:lib/type :mbql.stage/mbql})))) | |
This is basically [[clojure.string/join]] but uses commas to join everything but the last two args, which are joined
by a string (join-strings-with-conjunction "and" ["X" "Y" "Z"]) ;; => "X, Y, and Z" | (defn join-strings-with-conjunction
[conjunction coll]
(when (seq coll)
(if (= (count coll) 1)
(first coll)
(let [conjunction (str \space (str/trim conjunction) \space)]
(if (= (count coll) 2)
;; exactly 2 args: X and Y
(str (first coll) conjunction (second coll))
;; > 2 args: X, Y, and Z
(str
(str/join ", " (butlast coll))
","
conjunction
(last coll))))))) |
(mu/defn ^:private string-byte-count :- [:int {:min 0}]
"Number of bytes in a string using UTF-8 encoding."
[s :- :string]
#?(:clj (count (.getBytes (str s) "UTF-8"))
:cljs (.. (js/TextEncoder.) (encode s) -length))) | |
#?(:clj
(mu/defn ^:private string-character-at :- [:string {:min 0, :max 1}]
[s :- :string
i :-[:int {:min 0}]]
(str (.charAt ^String s i)))) | |
(mu/defn ^:private truncate-string-to-byte-count :- :string
"Truncate string `s` to `max-length-bytes` UTF-8 bytes (as opposed to truncating to some number of
*characters*)."
[s :- :string
max-length-bytes :- [:int {:min 1}]]
#?(:clj
(loop [i 0, cumulative-byte-count 0]
(cond
(= cumulative-byte-count max-length-bytes) (subs s 0 i)
(> cumulative-byte-count max-length-bytes) (subs s 0 (dec i))
(>= i (count s)) s
:else (recur (inc i)
(long (+
cumulative-byte-count
(string-byte-count (string-character-at s i)))))))
:cljs
(let [buf (js/Uint8Array. max-length-bytes)
result (.encodeInto (js/TextEncoder.) s buf)] ;; JS obj {read: chars_converted, write: bytes_written}
(subs s 0 (.-read result))))) | |
Length to truncate column and table identifiers to. See [[metabase.driver.impl/default-alias-max-length-bytes]] for reasoning. | (def ^:private truncate-alias-max-length-bytes 60) |
Length of the hash suffixed to truncated strings by [[truncate-alias]]. | (def ^:private truncated-alias-hash-suffix-length ;; 8 bytes for the CRC32 plus one for the underscore 9) |
(mu/defn ^:private crc32-checksum :- [:string {:min 8, :max 8}]
"Return a 4-byte CRC-32 checksum of string `s`, encoded as an 8-character hex string."
[s :- :string]
(let [s #?(:clj (Long/toHexString (.getValue (doto (java.util.zip.CRC32.)
(.update (.getBytes ^String s "UTF-8")))))
:cljs (-> (CRC32/str s 0)
(unsigned-bit-shift-right 0) ; see https://github.com/SheetJS/js-crc32#signed-integers
(.toString 16)))]
;; pad to 8 characters if needed. Might come out as less than 8 if the first byte is `00` or `0x` or something.
(loop [s s]
(if (< (count s) 8)
(recur (str \0 s))
s)))) | |
(mu/defn truncate-alias :- [:string {:min 1, :max 60}]
"Truncate string `s` if it is longer than [[truncate-alias-max-length-bytes]] and append a hex-encoded CRC-32
checksum of the original string. Truncated string is truncated to [[truncate-alias-max-length-bytes]]
minus [[truncated-alias-hash-suffix-length]] characters so the resulting string is
exactly [[truncate-alias-max-length-bytes]]. The goal here is that two really long strings that only differ at the
end will still have different resulting values.
(truncate-alias \"some_really_long_string\" 15) ; -> \"some_r_8e0f9bc2\"
(truncate-alias \"some_really_long_string_2\" 15) ; -> \"some_r_2a3c73eb\
([s]
(truncate-alias s truncate-alias-max-length-bytes))
([s :- ::lib.schema.common/non-blank-string
max-bytes :- [:int {:min 0}]]
(if (<= (string-byte-count s) max-bytes)
s
(let [checksum (crc32-checksum s)
truncated (truncate-string-to-byte-count s (- max-bytes truncated-alias-hash-suffix-length))]
(str truncated \_ checksum))))) | |
(mu/defn legacy-string-table-id->card-id :- [:maybe ::lib.schema.id/card]
"If `table-id` is a legacy `card__<id>`-style string, parse the `<id>` part to an integer Card ID. Only for legacy
queries! You don't need to use this in pMBQL since this is converted automatically by [[metabase.lib.convert]] to
`:source-card`."
[table-id]
(when (string? table-id)
(when-let [[_match card-id-str] (re-find #"^card__(\d+)$" table-id)]
(parse-long card-id-str)))) | |
(mu/defn source-table-id :- [:maybe ::lib.schema.id/table] "If this query has a `:source-table` ID, return it." [query] (-> query :stages first :source-table)) | |
(mu/defn source-card-id :- [:maybe ::lib.schema.id/card] "If this query has a `:source-card` ID, return it." [query] (-> query :stages first :source-card)) | |
(mu/defn unique-name-generator :- [:=>
[:cat ::lib.schema.common/non-blank-string]
::lib.schema.common/non-blank-string]
"Create a new function with the signature
(f str) => str
That takes any sort of string identifier (e.g. a column alias or table/join alias) and returns a guaranteed-unique
name truncated to 60 characters (actually 51 characters plus a hash)."
[]
(comp truncate-alias
(mbql.u/unique-name-generator
;; unique by lower-case name, e.g. `NAME` and `name` => `NAME` and `name_2`
:name-key-fn u/lower-case-en
;; truncate alias to 60 characters (actually 51 characters plus a hash).
:unique-alias-fn (fn [original suffix]
(truncate-alias (str original \_ suffix)))))) | |
(def ^:private strip-id-regex
#?(:cljs (js/RegExp. " id$" "i")
;; `(?i)` is JVM-specific magic to turn on the `i` case-insensitive flag.
:clj #"(?i) id$")) | |
(mu/defn strip-id :- :string
"Given a display name string like \"Product ID\", this will drop the trailing \"ID\" and trim whitespace.
Used to turn a FK field's name into a pseudo table name when implicitly joining."
[display-name :- :string]
(-> display-name
(str/replace strip-id-regex )
str/trim)) | |
(mu/defn add-summary-clause :- ::lib.schema/query
"If the given stage has no summary, it will drop :fields, :order-by, and :join :fields from it,
as well as any subsequent stages."
[query :- ::lib.schema/query
stage-number :- :int
location :- [:enum :breakout :aggregation]
a-summary-clause]
(let [query (pipeline query)
stage-number (or stage-number -1)
stage (query-stage query stage-number)
new-summary? (not (or (seq (:aggregation stage)) (seq (:breakout stage))))
new-query (update-query-stage
query stage-number
update location
(fn [summary-clauses]
(conj (vec summary-clauses) (lib.common/->op-arg a-summary-clause))))]
(if new-summary?
(-> new-query
(update-query-stage
stage-number
(fn [stage]
(-> stage
(dissoc :order-by :fields)
(m/update-existing :joins (fn [joins] (mapv #(dissoc % :fields) joins))))))
;; subvec holds onto references, so create a new vector
(update :stages (comp #(into [] %) subvec) 0 (inc (canonical-stage-index query stage-number))))
new-query))) | |
Utility code for dealing with visualization settings, from cards, dashboard cards, etc. There are two ways of representing the same data, DB form and normalized form. DB form is the "legacy" form, which uses unqualified keywords, which map directly to column names via Toucan. Normalized form, on the other hand, uses namespaced keywords and generally "unwraps" the semantic structures as much as possible. In general, operations/manipulations should happen on the normalized form, and when the DB form is needed again (ex: for updating the database), the map can be converted back. This can be done fairly easily with the threading macro, ex: ``` (-> (mb.viz/db->norm (:visualization_settings my-card)) tweak-viz-settings tweak-more-viz-settings mb.viz/norm->db) ``` In general, conversion functions in this namespace (i.e. those that convert various pieces from one form to the other)
will be prefixed with either | (ns metabase.shared.models.visualization-settings
#?@
(:clj
[(:require
[cheshire.core :as json]
[clojure.set :as set]
[clojure.spec.alpha :as s]
[medley.core :as m]
[metabase.mbql.normalize :as mbql.normalize])]
:cljs
[(:require
[clojure.set :as set]
[clojure.spec.alpha :as s]
[medley.core :as m]
[metabase.mbql.normalize :as mbql.normalize])])) |
-------------------------------------------------- Main API -------------------------------------------------- | |
-------------------------------------------------- Specs -------------------------------------------------- | |
(s/def ::field-id integer?) (s/def ::column-name string?) | |
a field reference that is a string, which could be a reference to some named field (ex: output of an aggregation) or to a fully qualified field name (in the context of serialization); we won't attempt to interpret it here, only report that it's a string and set it in the ref map appropriately | (s/def ::field-str string?) |
(s/def ::field-metadata (s/or :nil? nil? :map? map?)) (s/def ::column-ref (s/keys :opt [::field-id ::column-name ::field-str ::field-metadata])) | |
(s/def ::column-settings (s/keys)) (s/def ::click-behavior (s/keys)) (s/def ::visualization-settings (s/keys :opt [::column-settings ::click-behavior])) | |
(s/def ::field-id-vec (s/tuple #{"ref"}
(s/tuple #{"field"}
(s/or :field-id int? :field-str string?)
(s/or :field-metadata map? :nil nil?)))) | |
(s/def ::expression-vec (s/tuple #{"ref"} (s/tuple #{"expression"} string?))) | |
(s/def ::db-column-ref-vec (s/or :field ::field-id-vec
:expression ::expression-vec
:column-name (s/tuple (partial = "name") string?))) | |
(s/def ::click-behavior-type keyword? #_(s/or :cross-filter ::cross-filter
:link ::link)) | |
(s/def ::click-behavior (s/keys :req [::click-behavior-type]
:opt [::link-type ::parameter-mapping ::link-template ::link-text ::link-target-id])) | |
TODO: add more specific shape for this one | (s/def ::parameter-mapping (s/or :nil? nil? :map? map?)) |
target ID can be the auto generated ID or fully qualified name for serialization | (s/def ::link-target-id (s/or :int int? :fully-qualified-name string?)) (s/def ::link-template string?) (s/def ::link-text-template string?) |
(s/def ::column-title string?)
(s/def ::date-style #{"M/D/YYYY" "D/M/YYYY" "YYYY/M/D" "MMMM D, YYYY" "D MMMM, YYYY" "dddd, MMMM D, YYYY"})
(s/def ::date-abbreviate boolean?)
(s/def ::date-separator #{"/" "-" "."})
(s/def ::time-style #{"HH:mm" "h:mm A" "h A"})
(s/def ::time-enabled #{nil "minutes" "seconds" "milliseconds"})
(s/def ::decimals pos-int?)
(s/def ::number-separators #(or nil? (and string? (= 2 (count %)))))
(s/def ::number-style #{"decimal" "percent" "scientific" "currency"})
(s/def ::prefix string?)
(s/def ::suffix string?)
(s/def ::view-as string?)
(s/def ::link-text string?) | |
(s/def ::param-mapping-id string?) | |
(s/def ::param-ref-type #{"column" "dimension" "variable" "parameter"})
(s/def ::param-ref-id string?)
(s/def ::param-ref-name string?) | |
(s/def ::param-mapping-source (s/keys :req [::param-ref-id ::param-ref-type] :opt [::param-ref-name])) (s/def ::param-mapping-target ::param-mapping-source) | |
(s/def ::db-column-ref (s/or :string? string? :vector? vector? :keyword? keyword?)) | |
(s/def ::entity-type #{::card ::dashboard}) | |
----------------------------------------------- Parsing fns ----------------------------------------------- | |
Creates a normalized column ref map for the given field ID. This becomes a key in the If passed, | (defn field-id->column-ref
{:added "0.40.0"}
[field-id & [field-metadata]]
(cond-> {::field-id field-id}
(some? field-metadata) (assoc ::field-metadata field-metadata))) |
(s/fdef field-id->column-ref :args (s/cat :field-id int? :field-metadata (s/? ::field-metadata)) :ret ::column-ref) | |
Creates a normalized column ref map for the given | (defn column-name->column-ref
{:added "0.40.0"}
[col-name]
{::column-name col-name}) |
(s/fdef column-name->column-ref :args (s/cat :col-name string?) :ret ::column-ref) | |
Creates a normalized column ref map for the given field string (which could be the name of a "synthetic" field,
such as the output of an aggregation, or a fully qualified field name in the context of serialization. The
visualization settings code will not make any attempt to interpret this string. It becomes the
key in the If passed, | (defn field-str->column-ref
{:added "0.40.0"}
[field-qualified-name & [field-metadata]]
(cond-> {::field-str field-qualified-name}
(some? field-metadata) (assoc ::field-metadata field-metadata))) |
(s/fdef field-str->column-ref
:args (s/cat :field-qualified-name string? :field-metadata (s/? ::field-metadata))
:ret ::column-ref) | |
Returns the full string name of the keyword From https://clojuredocs.org/clojure.core/name#example-58264f85e4b0782b632278bf Clojure interprets slashes as keyword/name separators, so we need to do something hacky to get the "full" name here because our "keyword value" (as parsed from JSON/YAML/etc.) might actually look like the string version of a Clojure vector, which itself can contain a fully qualified name for serialization | (defn- keyname
{:added "0.40.0"}
[kw]
(str (when-let [kw-ns (namespace kw)] (str kw-ns "/")) (name kw))) |
(s/fdef keyname :args (s/cat :kw keyword?) :ret string?) | |
Parse the given | (defn- parse-json-string
[json-str]
#?(:clj (json/parse-string json-str)
:cljs (-> (.parse js/JSON json-str)
js->clj))) |
(s/fdef parse-json-string :args (s/cat :json-str string?) :ret (s/or :map map? :seq seqable?)) | |
Encode the given | (defn- encode-json-string
[obj]
#?(:clj (json/encode obj)
:cljs (.stringify js/JSON (clj->js obj)))) |
(s/fdef encode-json-string :args (s/cat :obj (s/or :map map? :seq seqable?)) :ret string?) | |
Converts a (parsed, vectorized) DB-form column ref to the equivalent normal form. Does the opposite of | (defn db->norm-column-ref
[column-ref-vec]
(let [parsed (s/conform ::db-column-ref-vec column-ref-vec)]
(if (s/invalid? parsed)
(throw (ex-info "Invalid input" (s/explain-data ::db-column-ref-vec column-ref-vec)))
(let [[m parts] parsed]
(case m
:field
(let [[_ [_ [_ [id-or-str v] [_ field-md]]]] parsed]
(cond-> (case id-or-str
:field-id {::field-id v}
:field-str {::field-str v})
(some? field-md) (assoc ::field-metadata field-md)))
:column-name
{::column-name (nth parts 1)}
:expression
(let [[_expression [_ref [_expression column-name]]] parsed]
{::column-name column-name})))))) |
(s/fdef db->norm-column-ref :args (s/cat :column-ref ::db-column-ref-vec) :ret ::column-ref) | |
Parses the DB representation of a column reference, and returns the equivalent normal form. The If a string, it is parsed as JSON, and the value is passed to If a keyword (which is produced by YAML parsing, for instance), it will first be converted to its full name. "Full"
means that the portions before and after any slashes will be included verbatim (via the If a vector, it is assumed that vector is already in DB normalized form, so it is passed directly to
Returns a map representing the column reference (conforming to the normal form | (defn parse-db-column-ref
{:added "0.40.0"}
[column-ref]
(let [parsed (s/conform ::db-column-ref column-ref)]
(if (s/invalid? parsed)
(throw (ex-info "Invalid input" (s/explain-data ::db-column-ref column-ref)))
(let [[k v] parsed
ref->vec (case k
:string? (comp vec parse-json-string)
:keyword? (comp vec parse-json-string keyname)
:vector? identity)]
(db->norm-column-ref (ref->vec v)))))) |
(s/fdef parse-db-column-ref :args (s/cat :column-ref ::db-column-ref) :ret ::column-ref) | |
------------------------------------------------ Builder fns ------------------------------------------------ | |
Creates an empty visualization settings map. Intended for use in the context of a threading macro (ex: with
| (defn visualization-settings
{:added "0.40.0"}
[]
{}) |
(defn- with-col-settings [settings]
(if (contains? settings ::column-settings)
settings
(assoc settings ::column-settings {}))) | |
(s/fdef with-col-settings :args (s/cat :settings ::visualization-settings) :ret ::visualization-settings) | |
Creates a crossfilter click action with the given | (defn crossfilter-click-action
{:added "0.40.0"}
[param-mapping]
{::click-behavior-type ::cross-filter
::parameter-mapping param-mapping}) |
(s/fdef crossfilter-click-action :args (s/cat :param-mapping ::parameter-mapping) :ret ::click-behavior) | |
Creates a URL click action linking to a | (defn url-click-action
{:added "0.40.0"}
[url-template]
{::click-behavior-type ::link
::link-type ::url
::link-template url-template}) |
(s/fdef url-click-action :args (s/cat :url-template string?) :ret ::click-behavior) | |
Creates a click action linking to an entity having | (defn entity-click-action
{:added "0.40.0"}
[entity-type entity-id & [parameter-mapping]]
(cond-> {::click-behavior-type ::link
::link-type entity-type
::link-target-id entity-id}
(some? parameter-mapping) (assoc ::parameter-mapping parameter-mapping))) |
(s/fdef entity-click-action :args (s/cat :entity-type ::entity-type :entity-id int? :parameter-mapping ::parameter-mapping) :ret ::click-behavior) | |
Creates a click action from a given | (defn with-click-action
{:added "0.40.0"}
[settings col-key action]
(-> settings
with-col-settings
(update ::column-settings assoc col-key {::click-behavior action}))) |
(s/fdef with-click-action :args (s/cat :settings map? :col-key ::column-ref :action ::click-behavior) :ret ::click-behavior) | |
Creates a click action from a given | (defn with-entity-click-action
{:added "0.40.0"}
[settings from-field-id to-entity-type to-entity-id & [parameter-mapping]]
(with-click-action settings (field-id->column-ref from-field-id) (entity-click-action
to-entity-type
to-entity-id
parameter-mapping))) |
(s/fdef with-entity-click-action
:args (s/cat :settings map?
:from-field-id int?
:to-entity-type ::entity-type
:to-entity-id int?
:parameter-mapping (s/? ::parameter-mapping))
:ret ::click-behavior) | |
Creates a parameter mapping for | (defn fk-parameter-mapping
{:added "0.40.0"}
[source-col-name source-field-id target-field-id]
(let [id [:dimension [:fk-> [:field source-field-id nil] [:field target-field-id nil]]]
dimension {:dimension [:field target-field-id {:source-field source-field-id}]}]
{id #::{:param-mapping-id id
:param-mapping-source #::{:param-ref-type "column"
:param-ref-id source-col-name
:param-ref-name source-col-name}
:param-mapping-target #::{:param-ref-type "dimension"
:param-ref-id id
:param-dimension dimension}}})) |
(s/fdef fk-parameter-mapping :args (s/cat :source-col-name string? :source-field-id int? :target-field-id int?) :ret map?) | |
---------------------------------------------- Conversion fns ---------------------------------------------- | |
(def ^:private db->norm-click-action-type
{"link" ::link
"crossfilter" ::cross-filter}) | |
(def ^:private norm->db-click-action-type (set/map-invert db->norm-click-action-type)) | |
(def ^:private db->norm-link-type
{"question" ::card
"dashboard" ::dashboard
"url" ::url}) | |
(def ^:private norm->db-link-type (set/map-invert db->norm-link-type)) | |
(def ^:private db->norm-click-behavior-keys
{:targetId ::link-target-id
:linkTemplate ::link-template
:linkTextTemplate ::link-text-template
:type ::click-behavior-type
:linkType ::link-type}) | |
(def ^:private norm->db-click-behavior-keys (set/map-invert db->norm-click-behavior-keys)) | |
(def ^:private db->norm-column-settings-keys
{:column_title ::column-title
:date_style ::date-style
:date_separator ::date-separator
:date_abbreviate ::date-abbreviate
:time_enabled ::time-enabled
:time_style ::time-style
:number_style ::number-style
:currency ::currency
:currency_style ::currency-style
:currency_in_header ::currency-in-header
:number_separators ::number-separators
:decimals ::decimals
:scale ::scale
:prefix ::prefix
:suffix ::suffix
:view_as ::view-as
:link_text ::link-text
:link_url ::link-url
:show_mini_bar ::show-mini-bar}) | |
(def ^:private norm->db-column-settings-keys (set/map-invert db->norm-column-settings-keys)) | |
(def ^:private db->norm-param-mapping-val-keys
{:id ::param-mapping-id
:source ::param-mapping-source
:target ::param-mapping-target}) | |
(def ^:private norm->db-param-mapping-val-keys (set/map-invert db->norm-param-mapping-val-keys)) | |
(def ^:private db->norm-param-ref-keys
{:type ::param-ref-type
:id ::param-ref-id
:name ::param-ref-name
:dimension ::param-dimension}) | |
(def ^:private norm->db-param-ref-keys (set/map-invert db->norm-param-ref-keys)) | |
(def ^:private db->norm-table-columns-keys
{:name ::table-column-name
; for now, do not translate the value of this key (the field vector)
:fieldref ::table-column-field-ref
:field_ref ::table-column-field-ref
:fieldRef ::table-column-field-ref
:enabled ::table-column-enabled}) | |
(def ^:private norm->db-table-columns-keys (set/map-invert db->norm-table-columns-keys)) | |
(s/def ::table-column-field-ref ::field-id-vec) | |
(defn- db->norm-param-ref [parsed-id param-ref]
(cond-> (set/rename-keys param-ref db->norm-param-ref-keys)
(= "dimension" (:type param-ref)) (assoc ::param-ref-id parsed-id))) | |
(defn- norm->db-param-ref [id-str param-ref]
(cond-> (set/rename-keys param-ref norm->db-param-ref-keys)
(= "dimension" (::param-ref-type param-ref)) (assoc :id id-str))) | |
Is this a parameter mapping for a dimension? Like when link refers a card getting data from another card. | (defn dimension-param-mapping? [mapping] (= "dimension" (get-in mapping [:target :type]))) |
Converts a | (defn db->norm-param-mapping
{:added "0.40.0"}
[parameter-mapping]
(if (nil? parameter-mapping)
nil
;; k is "[\"dimension\",[\"fk->\",[\"field-id\",%d],[\"field-id\",%d]]]"
;; v is {:id <same long string> :source <param-ref> :target <param-ref>}
(reduce-kv (fn [acc k v]
(let [[new-k new-v]
(if (dimension-param-mapping? v)
(let [parsed-id (-> (if (keyword? k) (keyname k) k)
parse-json-string
mbql.normalize/normalize-tokens)]
[parsed-id (cond-> v
(:source v) (assoc ::param-mapping-source
(db->norm-param-ref parsed-id (:source v)))
(:target v) (assoc ::param-mapping-target
(db->norm-param-ref parsed-id (:target v)))
:always (-> ; from outer cond->
(assoc ::param-mapping-id parsed-id)
(dissoc :source :target :id)))])
[k (-> v
(m/update-existing :source (partial db->norm-param-ref nil))
(m/update-existing :target (partial db->norm-param-ref nil))
(set/rename-keys db->norm-param-mapping-val-keys))])]
(assoc acc new-k new-v))) {} parameter-mapping))) |
(defn- norm->db-dimension-param-mapping [k v]
(let [str-id (encode-json-string k)]
[str-id (cond-> v
(::param-mapping-source v) (assoc :source
(norm->db-param-ref
str-id
(::param-mapping-source v)))
(::param-mapping-target v) (assoc :target
(norm->db-param-ref
str-id
(::param-mapping-target v)))
:always (->
(assoc :id str-id)
(dissoc ::param-mapping-id
::param-mapping-source
::param-mapping-target)))])) | |
(defn- norm->db-generic-param-mapping [pm-k pm-v]
(let [new-v (into {} (remove (fn [[k v]]
;; don't keep source or target unless not nil
(and (nil? v)
(contains? #{::param-mapping-source ::param-mapping-target} k)))) pm-v)]
[pm-k (-> new-v
(m/update-existing ::param-mapping-source (partial norm->db-param-ref nil))
(m/update-existing ::param-mapping-target (partial norm->db-param-ref nil))
(set/rename-keys norm->db-param-mapping-val-keys))])) | |
Converts a | (defn norm->db-param-mapping
{:added "0.40.0"}
[parameter-mapping]
(if (nil? parameter-mapping)
nil
(reduce-kv (fn [acc k v]
(let [[new-k new-v]
(if (= "dimension" (get-in v [::param-mapping-target ::param-ref-type]))
(norm->db-dimension-param-mapping k v)
(norm->db-generic-param-mapping k v))]
(assoc acc new-k new-v))) {} parameter-mapping))) |
(defn- db->norm-click-behavior [v]
(-> v
(assoc
::click-behavior-type
(db->norm-click-action-type (:type v)))
(dissoc :type)
(assoc ::link-type (db->norm-link-type (:linkType v)))
(dissoc :linkType)
(cond-> ; from outer ->
(some? (:parameterMapping v)) (assoc ::parameter-mapping (db->norm-param-mapping (:parameterMapping v))))
(dissoc :parameterMapping)
(set/rename-keys db->norm-click-behavior-keys))) | |
Converts the deprecated k:mm format to HH:mm (#18112) | (defn- db->norm-time-style
[v]
(if (= v "k:mm")
"HH:mm"
v)) |
(defn- db->norm-table-columns [v]
(-> v
(assoc ::table-columns (mapv (fn [tbl-col]
(set/rename-keys tbl-col db->norm-table-columns-keys))
(:table.columns v)))
(dissoc :table.columns))) | |
Converts the DB form of a :column_settings entry value to its normalized form. Does the opposite of
| (defn- db->norm-column-settings-entry
[m k v]
(case k
:click_behavior
(assoc m ::click-behavior (db->norm-click-behavior v))
:time_style
(assoc m ::time-style (db->norm-time-style v))
(assoc m (db->norm-column-settings-keys k) v))) |
Converts the DB form of a map of :column_settings entries to its normalized form. | (defn db->norm-column-settings-entries
[entries]
(reduce-kv db->norm-column-settings-entry {} entries)) |
Converts a :column_settings DB form to its normalized form. Drops any columns that fail to be parsed. | (defn db->norm-column-settings
[settings]
(reduce-kv (fn [m k v]
(try
(let [k1 (parse-db-column-ref k)
v1 (db->norm-column-settings-entries v)]
(assoc m k1 v1))
(catch #?(:clj Throwable :cljs js/Error) _e
m)))
{}
settings)) |
Converts a DB form of visualization settings (i.e. map with key Does the opposite of | (defn db->norm
{:added "0.40.0"}
[vs]
(cond-> vs
;; column_settings at top level; ex: table card
(:column_settings vs)
(assoc ::column-settings (->> (:column_settings vs)
db->norm-column-settings))
;; click behavior key at top level; ex: non-table card
(:click_behavior vs)
(assoc ::click-behavior (db->norm-click-behavior (:click_behavior vs)))
(:table.columns vs)
db->norm-table-columns
:always
(dissoc :column_settings :click_behavior))) |
(defn- norm->db-click-behavior-value [v]
(-> v
(assoc
:type
(norm->db-click-action-type (::click-behavior-type v)))
(dissoc ::click-behavior-type)
(cond-> ; from outer ->
(some? (::parameter-mapping v)) (assoc :parameterMapping (norm->db-param-mapping (::parameter-mapping v))))
(dissoc ::parameter-mapping)
(assoc :linkType (norm->db-link-type (::link-type v)))
(dissoc ::link-type)
(set/rename-keys norm->db-click-behavior-keys))) | |
(defn- norm->db-click-behavior [click-behavior]
(cond-> click-behavior
(some? (::parameter-mapping click-behavior))
(-> (assoc :parameterMapping (norm->db-param-mapping (::parameter-mapping click-behavior)))
(dissoc ::parameter-mapping))
:always (-> (assoc :type (norm->db-click-action-type (::click-behavior-type click-behavior)))
(m/assoc-some :linkType (norm->db-link-type (::link-type click-behavior)))
(dissoc ::link-type ::click-behavior-type ::parameter-mapping)
(set/rename-keys norm->db-click-behavior-keys)))) | |
Converts a ::column-settings entry from qualified form to DB form. Does the opposite of
| (defn- norm->db-column-settings-entry
[m k v]
(case k
::click-behavior (assoc m :click_behavior (norm->db-click-behavior v))
(assoc m (norm->db-column-settings-keys k) v))) |
Creates the DB form of a column ref (i.e. the key in the column settings map) for the given normalized args. Either
| (defn norm->db-column-ref
{:added "0.40.0"}
[{::keys [field-id field-str column-name field-metadata]}]
(-> (cond
(some? field-id) ["ref" ["field" field-id field-metadata]]
(some? field-str) ["ref" ["field" field-str field-metadata]]
(some? column-name) ["name" column-name])
encode-json-string)) |
Converts an entire column settings map from normalized to DB form. | (defn- norm->db-column-settings
[col-settings]
(->> col-settings
(m/map-kv (fn [k v]
[(norm->db-column-ref k) (reduce-kv norm->db-column-settings-entry {} v)])))) |
(defn- norm->db-table-columns [v]
(cond-> v
(some? (::table-columns v))
(assoc :table.columns (mapv (fn [tbl-col]
(set/rename-keys tbl-col norm->db-table-columns-keys))
(::table-columns v)))
:always
(dissoc ::table-columns))) | |
Converts the normalized form of visualization settings (i.e. a map having
Does The opposite of | (defn norm->db
{:added "0.40.0"}
[settings]
(cond-> settings
(::column-settings settings) (-> ; from cond->
(assoc :column_settings (norm->db-column-settings (::column-settings settings)))
(dissoc ::column-settings))
(::click-behavior settings) (-> ; from cond->
(assoc :click_behavior (norm->db-click-behavior-value (::click-behavior settings)))
(dissoc ::click-behavior))
(::table-columns settings) norm->db-table-columns)) |
/api/logs endpoints. These endpoints are meant to be used by admins to download logs before entries are auto-removed after the day limit. For example, the | (ns metabase-enterprise.advanced-config.api.logs (:require [clojure.string :as str] [compojure.core :refer [GET]] [malli.core :as mc] [malli.transform :as mtx] [metabase.api.common :as api] [metabase.db.connection :as mdb.connection] [metabase.util.i18n :refer [deferred-tru]] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
Query to fetch the rows within the specified | (mu/defn query-execution-logs
[year :- ms/PositiveInt
month :- ms/PositiveInt]
(let [date-part (fn [part-key part-value]
(if (= (mdb.connection/db-type) :postgres)
[:= [:date_part [:inline (name part-key)] :started_at] [:inline part-value]]
[:= [part-key :started_at] [:inline part-value]]))
results (t2/select :query_execution
{:order-by [[:started_at :desc]]
:where [:and
(date-part :year year)
(date-part :month month)]})]
results)) |
/query_execution/:yyyy-mm | (api/defendpoint GET
"Fetch rows for the month specified by `:yyyy-mm` from the query_execution logs table.
Must be a superuser."
[yyyy-mm]
{yyyy-mm (mu/with-api-error-message [:re #"\d{4}-\d{2}"]
(deferred-tru "Must be a string like 2020-04 or 2222-11."))}
(let [[year month] (mc/coerce [:tuple
[:int {:title "year" :min 0 :max 9999}]
[:int {:title "month" :min 0 :max 12}]]
(str/split yyyy-mm #"\-")
(mtx/string-transformer))]
(api/check-superuser)
(query-execution-logs year month))) |
(api/define-routes) | |
(ns metabase-enterprise.advanced-config.caching (:require [metabase.public-settings.premium-features :refer [defenterprise]])) | |
Returns the granular cache ttl (in seconds) for a card. On EE, this first checking whether there is a stored value for the card, dashboard, or database (in that order of decreasing preference). Returns nil on OSS. | (defenterprise granular-ttl
:feature :cache-granular-controls
[card dashboard database]
(let [ttls [(:cache_ttl card) (:cache_ttl dashboard) (:cache_ttl database)]
most-granular-ttl (first (filter some? ttls))]
(when most-granular-ttl ; stored TTLs are in hours; convert to seconds
(* most-granular-ttl 3600)))) |
States of | (defenterprise refreshable-states
:feature :cache-granular-controls
[]
#{"creating" "persisted" "error"}) |
States of | (defenterprise prunable-states
:feature :cache-granular-controls
[]
#{"deletable" "off"}) |
Support for initializing Metabase with configuration from a This logic is meant to be executed after the application database is set up and driver plugins have been initialized. The config file itself is a YAML file containing a map where each key corresponds to a different init section. For example, it might look something like this: version: 1 config: users: - first_name: Cam last_name: Saul password: 2cans email: cam@example.com - first_name: Cam last_name: Era password: 2cans email: cam.era@example.com databases: - type: postgres host: localhost port: 5432 name: test-data password: {{ env MYPOSTGRESPASSWORD }} settings: my-setting: 1234 Each section is handled by its corresponding [[initialize-section!]] method; the shape of each section may vary. VERSIONINGConfig files are required to have a These are not semantic versions! They're just simple floating point version numbers. That should be enough for our purposes. The idea here is that if we want to make changes to the config file shape in the future we'll be able to do so without having older Metabase code suddenly break in mysterious ways because it doesn't understand the new config shape, or newer Metabase code breaking if you try to use a config file using the older shape. For the time being, the minimum version we'll support is 1.0, which is the initial version of the config spec that
we're shipping with Metabase 45. We'll support all the way up to For example in Metabase 46 if we want to add some extra required keys that Metabase 45 can safely ignore, we can
define a new version 1.1 of the spec and specify Metabase 46 works with config versions If we want to introduce a breaking change that should not be backwards-compatible, such as introducing a new
template type, we can increment the major version to Spec validationThe contents of each section are automatically validated against the [[section-spec]] for that section. This validation is done before template expansion to avoid leaking sensitive values in the error messages that get logged. TemplatesAfter spec validation, the config map is walked and A template form like ``` {{env BIRDTYPE}} => (expand-parsed-template-form '(env BIRDTYPE)) => "toucan" ``` At the time of this writing, `env````yaml {{env MYENVVAR}} ``` Replaces the template with the value of an environment variable. The template consisting of two parts: the word
```yaml Java system property user.dir{{env user-dir}} ``` | (ns ^{:added "0.45.0"} metabase-enterprise.advanced-config.file
(:require
[clojure.edn :as edn]
[clojure.spec.alpha :as s]
[clojure.string :as str]
[clojure.walk :as walk]
[environ.core :as env]
[metabase-enterprise.advanced-config.file.databases]
[metabase-enterprise.advanced-config.file.interface
:as advanced-config.file.i]
[metabase-enterprise.advanced-config.file.settings]
[metabase-enterprise.advanced-config.file.users]
[metabase.driver.common.parameters]
[metabase.driver.common.parameters.parse :as params.parse]
[metabase.public-settings.premium-features :as premium-features]
[metabase.util :as u]
[metabase.util.files :as u.files]
[metabase.util.i18n :refer [trs tru]]
[metabase.util.log :as log]
[metabase.util.yaml :as yaml])) |
(comment ;; for parameter parsing metabase.driver.common.parameters/keep-me ;; for `settings:` section code metabase-enterprise.advanced-config.file.settings/keep-me ;; for `databases:` section code metabase-enterprise.advanced-config.file.databases/keep-me ;; for `users:` section code metabase-enterprise.advanced-config.file.users/keep-me) | |
(set! *warn-on-reflection* true) | |
(s/def :metabase.config.file.config/config
(s/and
map?
(fn validate-section-configs [m]
(doseq [[section-name section-config] m
:let [spec (advanced-config.file.i/section-spec section-name)]]
(s/assert* spec section-config))
true))) | |
Range of config file versions (inclusive) that we'll support. If the version is out of this range, spec validation will fail and trigger an error. See ns documentation for [[metabase.config.file]] for more details. | (def ^:private ^:dynamic *supported-versions*
{:min 1.0, :max 1.999}) |
(defn- supported-version? [n] (<= (:min *supported-versions*) n (:max *supported-versions*))) | |
(s/def :metabase.config.file.config/version (s/and number? supported-version?)) | |
(s/def ::config
(s/keys :req-un [:metabase.config.file.config/version
:metabase.config.file.config/config])) | |
Environment variables and system properties used in this namespace. This is a dynamic version of [[environ.core/env]]; it is dynamic for test mocking purposes. Yes, [[metabase.test/with-temp-env-var-value!]] exists, but it is not allowed inside parallel tests. This is an experiment that I may adapt into a new pattern in the future to allow further test parallelization. | (def ^:private ^:dynamic *env* env/env) |
Path for the YAML config file Metabase should use for initialization and Settings values. | (defn- path
^java.nio.file.Path []
(let [path* (or (some-> (get *env* :mb-config-file-path) u.files/get-path)
(u.files/get-path (System/getProperty "user.dir") "config.yml"))]
(if (u.files/exists? path*)
(log/info (u/colorize :magenta
(trs "Found config file at path {0}; Metabase will be initialized with values from this file"
(pr-str (str path*))))
(u/emoji "🗄️"))
(log/info (u/colorize :yellow (trs "No config file found at path {0}" (pr-str (str path*))))))
path*)) |
Override the config contents as returned by [[config]], for test mocking purposes. | (def ^:private ^:dynamic *config* nil) |
(defmulti ^:private expand-parsed-template-form
{:arglists '([form])}
(fn [form]
(symbol (first form)))) | |
(defmethod expand-parsed-template-form :default
[form]
(throw (ex-info (trs "Don''t know how to expand template form: {0}" (pr-str form))
{:form form}))) | |
(defmethod expand-parsed-template-form 'env [[_template-type env-var-name]] (get *env* (keyword (u/->kebab-case-en env-var-name)))) | |
(defmulti ^:private expand-template-str-part
{:arglists '([part])}
type) | |
(defmethod expand-template-str-part String [s] s) | |
(defn- valid-template-type? [symb]
(and (symbol? symb)
(get (methods expand-parsed-template-form) symb))) | |
(s/def ::template-form
(s/or :env (s/cat :template-type (s/and symbol? valid-template-type?)
:env-var-name symbol?))) | |
(defmethod expand-template-str-part metabase.driver.common.parameters.Param
[{s :k}]
{:pre [(string? s)]}
(when (seq s)
(when-let [obj (try
(not-empty (edn/read-string (str "( " s " )")))
(catch Throwable e
(throw (ex-info (trs "Error parsing template string {0}: {1}" (pr-str s) (ex-message e))
{:template-string s}))))]
(s/assert* ::template-form obj)
(expand-parsed-template-form obj)))) | |
(defmethod expand-template-str-part metabase.driver.common.parameters.Optional
[{:keys [args]}]
(let [parts (map expand-template-str-part args)]
(when (every? seq parts)
(str/join parts)))) | |
(defn- expand-templates-in-str [s] (str/join (map expand-template-str-part (params.parse/parse s)))) | |
(defn- expand-templates [m]
(walk/postwalk
(fn [form]
(cond-> form
(string? form) expand-templates-in-str))
m)) | |
Contents of the config file if it exists, otherwise | (defn- config
[]
(when-let [m (or *config*
(yaml/from-file (str (path))))]
(s/assert* ::config m)
(expand-templates m))) |
Sort the various config sections. The | (defn- sort-by-initialization-order
[config-sections]
(let [{settings-sections true, other-sections false} (group-by (fn [[section-name]]
(= section-name :settings))
config-sections)]
(concat settings-sections other-sections))) |
Initialize Metabase according to the directives in the config file, if it exists. | (defn ^{:added "0.45.0"} initialize!
[]
;; TODO -- this should only do anything if we have an appropriate token (we should get a token for testing this before
;; enabling that check tho)
(when-let [m (config)]
(doseq [[section-name section-config] (sort-by-initialization-order (:config m))]
;; you can only use the config-from-file stuff with an EE/Pro token with the `:config-text-file` feature. Since you
;; might have to use the `:settings` section to set the token, skip the check for Settings. But check it for the
;; other sections.
(when-not (= section-name :settings)
(when-not (premium-features/enable-config-text-file?)
(throw (ex-info (tru "Metabase config files require a Premium token with the :config-text-file feature.")
{}))))
(log/info (u/colorize :magenta (trs "Initializing {0} from config file..." section-name)) (u/emoji "🗄️"))
(advanced-config.file.i/initialize-section! section-name section-config))
(log/info (u/colorize :magenta (trs "Done initializing from file.")) (u/emoji "🗄️")))
:ok) |
(ns metabase-enterprise.advanced-config.file.databases (:require [clojure.spec.alpha :as s] [metabase-enterprise.advanced-config.file.interface :as advanced-config.file.i] [metabase.driver.util :as driver.u] [metabase.models.database :refer [Database]] [metabase.models.setting :refer [defsetting]] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [toucan2.core :as t2])) | |
Whether to sync newly created Databases during config-from-file initialization. By default, true, but you can disable this behavior if you want to sync it manually or use SerDes to populate its data model. | (defsetting config-from-file-sync-databases :visibility :internal :type :boolean :default true :audit :getter) |
(s/def :metabase-enterprise.advanced-config.file.databases.config-file-spec/name string?) | |
(s/def :metabase-enterprise.advanced-config.file.databases.config-file-spec/engine string?) | |
(s/def :metabase-enterprise.advanced-config.file.databases.config-file-spec/details map?) | |
(s/def ::config-file-spec
(s/keys :req-un [:metabase-enterprise.advanced-config.file.databases.config-file-spec/engine
:metabase-enterprise.advanced-config.file.databases.config-file-spec/name
:metabase-enterprise.advanced-config.file.databases.config-file-spec/details])) | |
(defmethod advanced-config.file.i/section-spec :databases [_section] (s/spec (s/* ::config-file-spec))) | |
(defn- init-from-config-file!
[database]
;; assert that we are able to connect to this Database. Otherwise, throw an Exception.
(driver.u/can-connect-with-details? (keyword (:engine database)) (:details database) :throw-exceptions)
(if-let [existing-database-id (t2/select-one-pk Database :engine (:engine database), :name (:name database))]
(do
(log/info (u/colorize :blue (trs "Updating Database {0} {1}" (:engine database) (pr-str (:name database)))))
(t2/update! Database existing-database-id database))
(do
(log/info (u/colorize :green (trs "Creating new {0} Database {1}" (:engine database) (pr-str (:name database)))))
(let [db (first (t2/insert-returning-instances! Database database))]
(if (config-from-file-sync-databases)
((requiring-resolve 'metabase.sync/sync-database!) db)
(log/info (trs "Sync on database creation when initializing from file is disabled. Skipping sync."))))))) | |
(defmethod advanced-config.file.i/initialize-section! :databases
[_section-name databases]
(doseq [database databases]
(init-from-config-file! database))) | |
(ns metabase-enterprise.advanced-config.file.interface (:require [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log])) | |
Spec that should be used to validate the config section with Sections are validated BEFORE template expansion, so as to avoid leaking any sensitive values in spec errors. Write your specs accordingly! Implementations of this method live in other namespaces. For example, the section spec for the | (defmulti section-spec
{:arglists '([section-name])}
keyword) |
(defmethod section-spec :default [_section-name] any?) | |
Execute initialization code for the section of the init config file with the key Implementations of this method live in other namespaces, for example the method for the | (defmulti initialize-section!
{:arglists '([section-name section-config])}
(fn [section-name _section-config]
(keyword section-name))) |
if we don't know how to initialize a particular section, just log a warning and proceed. This way we can be forward-compatible and handle sections that might be unknown in a particular version of Metabase. | (defmethod initialize-section! :default
[section-name _section-config]
(log/warn (u/colorize :yellow (trs "Ignoring unknown config section {0}." (pr-str section-name))))) |
(ns metabase-enterprise.advanced-config.file.settings (:require [clojure.spec.alpha :as s] [metabase-enterprise.advanced-config.file.interface :as advanced-config.file.i] [metabase.models.setting :as setting] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log])) | |
(defmethod advanced-config.file.i/section-spec :settings [_section-name] (s/map-of keyword? any?)) | |
(defmethod advanced-config.file.i/initialize-section! :settings
[_section-name settings]
(log/info (trs "Setting setting values from config file"))
(doseq [[setting-name setting-value] settings]
(log/info (trs "Setting value for Setting {0}" setting-name))
(setting/set! setting-name setting-value))) | |
(ns metabase-enterprise.advanced-config.file.users (:require [clojure.spec.alpha :as s] [metabase-enterprise.advanced-config.file.interface :as advanced-config.file.i] [metabase.models.user :refer [User]] [metabase.util :as u] [metabase.util.i18n :as i18n :refer [trs]] [metabase.util.log :as log] [toucan2.core :as t2])) | |
(s/def :metabase-enterprise.advanced-config.file.users.config-file-spec/first_name string?) | |
(s/def :metabase-enterprise.advanced-config.file.users.config-file-spec/last_name string?) | |
(s/def :metabase-enterprise.advanced-config.file.users.config-file-spec/password string?) | |
(s/def :metabase-enterprise.advanced-config.file.users.config-file-spec/email string?) | |
(s/def ::config-file-spec
(s/keys :req-un [:metabase-enterprise.advanced-config.file.users.config-file-spec/first_name
:metabase-enterprise.advanced-config.file.users.config-file-spec/last_name
:metabase-enterprise.advanced-config.file.users.config-file-spec/password
:metabase-enterprise.advanced-config.file.users.config-file-spec/email])) | |
(defmethod advanced-config.file.i/section-spec :users [_section] (s/spec (s/* ::config-file-spec))) | |
For [[init-from-config-file!]]: | (defn- init-from-config-file-is-first-user? [] (zero? (t2/count User))) |
(defn- init-from-config-file!
[user]
;; TODO -- if this is the FIRST user, we should probably make them a superuser, right?
(if-let [existing-user-id (t2/select-one-pk User :email (:email user))]
(do
(log/info (u/colorize :blue (trs "Updating User with email {0}" (pr-str (:email user)))))
(t2/update! User existing-user-id user))
;; create a new user. If they are the first User, force them to be an admin.
(let [user (cond-> user
(init-from-config-file-is-first-user?) (assoc :is_superuser true))]
(log/info (u/colorize :green (trs "Creating the first User for this instance. The first user is always created as an admin.")))
(log/info (u/colorize :green (trs "Creating new User {0} with email {1}"
(pr-str (str (:first_name user) \space (:last_name user)))
(pr-str (:email user)))))
(t2/insert! User user)))) | |
(defmethod advanced-config.file.i/initialize-section! :users
[_section-name users]
(doseq [user users]
(init-from-config-file! user))) | |
(ns metabase-enterprise.advanced-config.models.pulse-channel (:require [clojure.string :as str] [metabase.models.setting :as setting :refer [defsetting]] [metabase.public-settings.premium-features :as premium-features] [metabase.util :as u] [metabase.util.i18n :refer [deferred-tru tru]])) | |
(defsetting subscription-allowed-domains (deferred-tru "Allowed email address domain(s) for new Dashboard Subscriptions and Alerts. To specify multiple domains, separate each domain with a comma, with no space in between. To allow all domains, leave the field empty. This setting doesn’t affect existing subscriptions.") :visibility :public :export? true :feature :email-allow-list ;; this is a comma-separated string but we're not using `:csv` because it gets serialized to an array which makes it ;; inconvenient to use on the frontend. :type :string :audit :getter) | |
Parse [[subscription-allowed-domains]] into a set. | (defn- allowed-domains-set
[]
(some-> (subscription-allowed-domains)
(str/split #",")
set
not-empty)) |
Check that This function is called by [[metabase.models.pulse-channel/validate-email-domains]] when Pulses are created and updated. | (defn validate-email-domains
[email-addresses]
(when (premium-features/enable-email-allow-list?)
(when-let [allowed-domains (allowed-domains-set)]
(doseq [email email-addresses
:let [domain (u/email->domain email)]]
(assert (u/email? email)
(tru "Invalid email address: {0}" (pr-str email)))
(when-not (contains? allowed-domains domain)
(throw (ex-info (tru "You cannot create new subscriptions for the domain {0}. Allowed domains are: {1}"
(pr-str domain)
(str/join ", " allowed-domains))
{:email email
:allowed-domains allowed-domains
:status-code 403}))))))) |
| (ns metabase-enterprise.advanced-permissions.api.application (:require [compojure.core :refer [GET PUT]] [metabase-enterprise.advanced-permissions.models.permissions.application-permissions :as a-perms] [metabase.api.common :as api])) |
(set! *warn-on-reflection* true) | |
/graph | (api/defendpoint GET "Fetch a graph of Application Permissions." [] (api/check-superuser) (a-perms/graph)) |
(defn- dejsonify-application-permissions
[application-permissions]
(into {} (for [[perm-type perm-value] application-permissions]
[perm-type (keyword perm-value)]))) | |
(defn- dejsonify-groups
[groups]
(into {} (for [[group-id application-permissions] groups]
[(Integer/parseInt (name group-id))
(dejsonify-application-permissions application-permissions)]))) | |
Fix the types in the graph when it comes in from the API, e.g. converting things like | (defn- dejsonify-graph [graph] (update graph :groups dejsonify-groups)) |
/graph | (api/defendpoint PUT
"Do a batch update of Application Permissions by passing a modified graph."
[:as {:keys [body]}]
(api/check-superuser)
(-> body
dejsonify-graph
a-perms/update-graph!)
(a-perms/graph)) |
(api/define-routes) | |
(ns metabase-enterprise.advanced-permissions.api.impersonation (:require [compojure.core :refer [GET]] [metabase.api.common :as api] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) | |
/ | (api/defendpoint GET
"Fetch a list of all Impersonation policies currently in effect, or a single policy if both `group_id` and `db_id`
are provided."
[group_id db_id]
{group_id [:maybe ms/PositiveInt]
db_id [:maybe ms/PositiveInt]}
(api/check-superuser)
(if (and group_id db_id)
(t2/select-one :model/ConnectionImpersonation :group_id group_id :db_id db_id)
(t2/select :model/ConnectionImpersonation {:order-by [[:id :asc]]}))) |
/:id | (api/defendpoint DELETE
"Delete a Connection Impersonation entry."
[id]
{id ms/PositiveInt}
(api/check-superuser)
(api/check-404 (t2/select-one :model/ConnectionImpersonation :id id))
(t2/delete! :model/ConnectionImpersonation :id id)
api/generic-204-no-content) |
(api/define-routes) | |
(ns metabase-enterprise.advanced-permissions.api.routes
(:require
[compojure.core :as compojure]
[metabase-enterprise.advanced-permissions.api.application
:as application]
[metabase-enterprise.advanced-permissions.api.impersonation
:as impersonation]
[metabase.api.routes.common :refer [+auth]])) | |
Ring routes for advanced permissions API endpoints. | (compojure/defroutes routes (compojure/context "/application" [] (+auth application/routes)) (compojure/context "/impersonation" [] (+auth impersonation/routes))) |
(ns metabase-enterprise.advanced-permissions.api.util
(:require
[metabase.api.common :refer [*current-user-id* *is-superuser?*]]
[metabase.models.permissions-group-membership
:refer [PermissionsGroupMembership]]
[metabase.public-settings.premium-features :refer [defenterprise]]
[metabase.util.i18n :refer [tru]]
[toucan2.core :as t2])) | |
Returns a boolean if the current user is in a group that has a connection impersonation in place for any database. Note: this function does not check whether the impersonation is enforced for the current user, since another group's permissions may supercede it. Will throw an error if [[api/current-user-id]] is not bound. TODO: this function should only return true if an impersonation policy is enforced for the user | (defenterprise impersonated-user?
:feature :advanced-permissions
[]
(boolean
(when-not *is-superuser?*
(if *current-user-id*
(let [group-ids (t2/select-fn-set :group_id PermissionsGroupMembership :user_id *current-user-id*)]
(seq
(when (seq group-ids)
(t2/select :model/ConnectionImpersonation :group_id [:in group-ids]))))
;; If no *current-user-id* is bound we can't check for impersonations, so we should throw in this case to avoid
;; returning `false` for users who should actually be using impersonation.
(throw (ex-info (str (tru "No current user found"))
{:status-code 403})))))) |
(ns metabase-enterprise.advanced-permissions.common (:require [metabase.api.common :as api] [metabase.models :refer [PermissionsGroupMembership]] [metabase.models.permissions :as perms] [metabase.public-settings.premium-features :as premium-features] [metabase.util :as u] [toucan2.core :as t2])) | |
Adds to | (defn with-advanced-permissions
[user]
(let [permissions-set @api/*current-user-permissions-set*]
(assoc user :permissions
{:can_access_setting (perms/set-has-application-permission-of-type? permissions-set :setting)
:can_access_subscription (perms/set-has-application-permission-of-type? permissions-set :subscription)
:can_access_monitoring (perms/set-has-application-permission-of-type? permissions-set :monitoring)
:can_access_data_model (perms/set-has-partial-permissions? permissions-set "/data-model/")
:can_access_db_details (perms/set-has-partial-permissions? permissions-set "/details/")
:is_group_manager api/*is-group-manager?*}))) |
Check if | (defn current-user-has-application-permissions?
[perm-type]
(or api/*is-superuser?*
(perms/set-has-application-permission-of-type? @api/*current-user-permissions-set* perm-type))) |
Return true if current-user is a manager of | (defn current-user-is-manager-of-group?
[group-or-id]
(t2/select-one-fn :is_group_manager PermissionsGroupMembership
:user_id api/*current-user-id* :group_id (u/the-id group-or-id))) |
Given a list of tables, removes the ones for which | (defn filter-tables-by-data-model-perms
[tables]
(cond
api/*is-superuser?*
tables
;; If advanced-permissions is not enabled, no non-admins have any data-model editing perms, so return an empty list
(not (premium-features/enable-advanced-permissions?))
(empty tables)
:else
(filter
(fn [{table-id :id db-id :db_id schema :schema}]
(perms/set-has-full-permissions? @api/*current-user-permissions-set*
(perms/feature-perms-path :data-model :all db-id schema table-id)))
tables))) |
Given a list of schema, remove the ones for which | (defn filter-schema-by-data-model-perms
[schema]
(cond
api/*is-superuser?*
schema
;; If advanced-permissions is not enabled, no non-admins have any data-model editing perms, so return an empty list
(not (premium-features/enable-advanced-permissions?))
(empty schema)
:else
(filter
(fn [{db-id :db_id schema :schema}]
(perms/set-has-partial-permissions? @api/*current-user-permissions-set*
(perms/feature-perms-path :data-model :all db-id schema)))
schema))) |
Given a list of databases, removes the ones for which | (defn filter-databases-by-data-model-perms
[dbs]
(cond
api/*is-superuser?*
dbs
;; If advanced-permissions is not enabled, no non-admins have any data-model editing perms, so return an empty list
(not (premium-features/enable-advanced-permissions?))
(empty dbs)
:else
(reduce
(fn [result {db-id :id tables :tables :as db}]
(if (perms/set-has-partial-permissions? @api/*current-user-permissions-set*
(perms/feature-perms-path :data-model :all db-id))
(if tables
(conj result (update db :tables filter-tables-by-data-model-perms))
(conj result db))
result))
[]
dbs))) |
(ns metabase-enterprise.advanced-permissions.driver.impersonation
(:require
[clojure.set :as set]
[clojure.string :as str]
[metabase.api.common :as api]
[metabase.driver :as driver]
[metabase.driver.sql :as driver.sql]
[metabase.models.field :as field]
[metabase.models.permissions :as perms :refer [Permissions]]
[metabase.models.permissions-group-membership
:refer [PermissionsGroupMembership]]
[metabase.public-settings.premium-features :as premium-features :refer [defenterprise]]
[metabase.util :as u]
[metabase.util.i18n :refer [tru]]
[metabase.util.log :as log]
[toucan2.core :as t2])
(:import
(java.sql Connection))) | |
(set! *warn-on-reflection* true) | |
Takes the permission set for each group a user is in, and an impersonation policy, and determines whether the policy should be enforced. This is done by checking whether the union of permissions in all other groups provides full data access to the database. If so, we don't enforce the policy, because theo ther groups' permissions supercede it. | (defn- enforce-impersonation?
[group-id->perms-set {db-id :db_id}]
(let [perms-set (apply set/union (vals group-id->perms-set))]
(not (perms/set-has-full-permissions? perms-set (perms/all-schemas-path db-id))))) |
Given a list of Connection Impersonation policies and a list of permission group IDs that the current user is in, filter the policies to only include ones that should be enforced for the current user. An impersonation policy is not enforced if the user is in a different permission group that grants full access to the database. | (defn- enforced-impersonations
[impersonations group-ids]
(let [non-impersonated-group-ids (set/difference (set group-ids)
(set (map :group_id impersonations)))
perms (when (seq non-impersonated-group-ids)
(t2/select Permissions {:where [:in :group_id non-impersonated-group-ids]}))
group-id->perms-set (-> (group-by :group_id perms)
(update-vals (fn [perms] (into #{} (map :object) perms))))]
(filter (partial enforce-impersonation? group-id->perms-set)
impersonations))) |
Is impersonation enabled for the given database, for any groups? | (defn- impersonation-enabled-for-db?
[db-or-id]
(boolean
(when (and db-or-id (premium-features/enable-advanced-permissions?))
(t2/exists? :model/ConnectionImpersonation :db_id (u/id db-or-id))))) |
Fetches the database role that should be used for the current user, if connection impersonation is in effect.
Returns | (defn connection-impersonation-role
[database-or-id]
(when (and database-or-id (not api/*is-superuser?*))
(let [group-ids (t2/select-fn-set :group_id PermissionsGroupMembership :user_id api/*current-user-id*)
conn-impersonations (enforced-impersonations
(when (seq group-ids)
(t2/select :model/ConnectionImpersonation
:group_id [:in group-ids]
:db_id (u/the-id database-or-id)))
group-ids)
role-attributes (set (map :attribute conn-impersonations))]
(when (> (count role-attributes) 1)
(throw (ex-info (tru "Multiple conflicting connection impersonation policies found for current user")
{:user-id api/*current-user-id*
:conn-impersonations conn-impersonations})))
(when (not-empty role-attributes)
(let [conn-impersonation (first conn-impersonations)
role-attribute (:attribute conn-impersonation)
user-attributes (:login_attributes @api/*current-user*)
role (get user-attributes role-attribute)]
(if (str/blank? role)
(throw (ex-info (tru "User does not have attribute required for connection impersonation.")
{:user-id api/*current-user-id*
:conn-impersonations conn-impersonations}))
role)))))) |
Returns a hash-key for FieldValues if the current user uses impersonation for the database. | (defenterprise hash-key-for-impersonation
:feature :advanced-permissions
[field-id]
;; Include the role in the hash key, so that we can cache the results of the query for each role.
(let [db-id (field/field-id->database-id field-id)]
(str (hash [field-id (connection-impersonation-role db-id)])))) |
Executes a | (defenterprise set-role-if-supported!
:feature :advanced-permissions
[driver ^Connection conn database]
(when (driver/database-supports? driver :connection-impersonation database)
(try
(let [enabled? (impersonation-enabled-for-db? database)
default-role (driver.sql/default-database-role driver database)
impersonation-role (and enabled? (connection-impersonation-role database))]
(when (and enabled? (not default-role))
(throw (ex-info (tru "Connection impersonation is enabled for this database, but no default role is found")
{:user-id api/*current-user-id*
:database-id (u/the-id database)})))
(when-let [role (or impersonation-role default-role)]
;; If impersonation is not enabled for any groups but we have a default role, we should still set it, just
;; in case impersonation used to be enabled and the connection still uses an impersonated role.
(driver/set-role! driver conn role)))
(catch Throwable e
(log/debug e (tru "Error setting role on connection"))
(throw e))))) |
Model definition for Connection Impersonations, which are used to define specific database roles used by users in certain permission groups when running queries. | (ns metabase-enterprise.advanced-permissions.models.connection-impersonation (:require [medley.core :as m] [metabase.models.interface :as mi] [metabase.public-settings.premium-features :refer [defenterprise]] [metabase.util.log :as log] [methodical.core :as methodical] [toucan2.core :as t2])) |
(doto :model/ConnectionImpersonation (derive :metabase/model) ;; Only admins can work with Connection Impersonation configs (derive ::mi/read-policy.superuser) (derive ::mi/write-policy.superuser)) | |
(methodical/defmethod t2/table-name :model/ConnectionImpersonation [_model] :connection_impersonations) | |
Augment a provided permissions graph with active connection impersonation policies. | (defenterprise add-impersonations-to-permissions-graph
:feature :advanced-permissions
[graph]
(m/deep-merge
graph
(let [impersonations (t2/select :model/ConnectionImpersonation)]
(reduce (fn [acc {:keys [db_id group_id]}]
(assoc-in acc [group_id db_id] {:data {:schemas :impersonated}}))
{}
impersonations)))) |
Create new Connection Impersonation records. Deletes any existing Connection Impersonation records for the same group and database before creating new ones. | (defenterprise insert-impersonations!
:feature :advanced-permissions
[impersonations]
(doall
(for [impersonation impersonations]
(do
(t2/delete! :model/ConnectionImpersonation
:group_id (:group_id impersonation)
:db_id (:db_id impersonation))
(-> (t2/insert-returning-instances! :model/ConnectionImpersonation impersonation)
first))))) |
(defn- delete-impersonations-for-group-database! [{:keys [group-id database-id]} changes]
(log/debugf "Deleting unneeded Connection Impersonations for Group %d for Database %d. Graph changes: %s"
group-id database-id (pr-str changes))
(when (not= :impersonated changes)
(log/debugf "Group %d %s for Database %d, deleting all Connection Impersonations for this DB"
group-id
(case changes
:none "no longer has any perms"
:all "now has full data perms"
:block "is now BLOCKED from all non-data-perms access")
database-id)
(t2/delete! :model/ConnectionImpersonation :group_id group-id :db_id database-id))) | |
(defn- delete-impersonations-for-group! [{:keys [group-id]} changes]
(log/debugf "Deleting unneeded Connection Impersonation policies for Group %d. Graph changes: %s" group-id (pr-str changes))
(doseq [database-id (set (keys changes))]
(when-let [data-perm-changes (get-in changes [database-id :data :schemas])]
(delete-impersonations-for-group-database!
{:group-id group-id, :database-id database-id}
data-perm-changes)))) | |
For use only inside | (defenterprise delete-impersonations-if-needed-after-permissions-change!
:feature :advanced-permissions
[changes]
(log/debug "Permissions updated, deleting unneeded Connection Impersonations...")
(doseq [group-id (set (keys changes))]
(delete-impersonations-for-group! {:group-id group-id} (get changes group-id)))
(log/debug "Done deleting unneeded Connection Impersonations.")) |
(ns metabase-enterprise.advanced-permissions.models.permissions (:require [metabase.models.permissions :as perms] [metabase.public-settings.premium-features :as premium-features] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms])) | |
+----------------------------------------------------------------------------------------------------------------+ | Shared Util Functions | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- grant-permissions!
{:arglists '([perm-type perm-value group-id db-id]
[perm-type perm-value group-id db-id schema-name]
[perm-type perm-value group-id db-id schema-name table-or-id])}
[perm-type perm-value group-id & path-components]
(perms/grant-permissions! group-id (perms/base->feature-perms-path
perm-type
perm-value
(apply perms/data-perms-path path-components)))) | |
(defn- revoke-permissions!
{:arglists '([perm-type perm-value group-id db-id]
[perm-type perm-value group-id db-id schema-name]
[perm-type perm-value group-id db-id schema-name table-or-id])}
[perm-type perm-value group-id & path-components]
(perms/delete-related-permissions! group-id
(apply (partial perms/feature-perms-path perm-type perm-value) path-components))) | |
+----------------------------------------------------------------------------------------------------------------+ | Download permissions | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- all-schemas-path [perm-type perm-value db-id] (perms/base->feature-perms-path perm-type perm-value (perms/all-schemas-path db-id))) | |
(defn- grant-permissions-for-all-schemas! [perm-type perm-value group-id db-id] (perms/grant-permissions! group-id (all-schemas-path perm-type perm-value db-id))) | |
(defn- revoke-download-permissions!
{:arglists '([group-id db-id]
[group-id db-id schema-name]
[group-id db-id schema-name table-or-id])}
[group-id & path-components]
(apply (partial perms/revoke-download-perms! group-id) path-components)) | |
(defn- update-table-download-permissions!
[group-id db-id schema table-id new-table-perms]
(condp = new-table-perms
:full
(do
(revoke-download-permissions! group-id db-id schema table-id)
(perms/grant-permissions! group-id (perms/feature-perms-path :download :full db-id schema table-id)))
:limited
(do
(revoke-download-permissions! group-id db-id schema table-id)
(perms/grant-permissions! group-id (perms/feature-perms-path :download :limited db-id schema table-id)))
:none
(revoke-download-permissions! group-id db-id schema table-id))) | |
(defn- update-schema-download-permissions!
[group-id db-id schema new-schema-perms]
(condp = new-schema-perms
:full
(do
(revoke-download-permissions! group-id db-id schema)
(perms/grant-permissions! group-id (perms/feature-perms-path :download :full db-id schema)))
:limited
(do
(revoke-download-permissions! group-id db-id schema)
(perms/grant-permissions! group-id (perms/feature-perms-path :download :limited db-id schema)))
:none
(revoke-download-permissions! group-id db-id schema)
(when (map? new-schema-perms)
(doseq [[table-id table-perms] new-schema-perms]
(update-table-download-permissions! group-id db-id schema table-id table-perms))))) | |
Update the download permissions graph for a database. This mostly works similar to [[metabase.models.permission/update-db-data-access-permissions!]], with a few key differences: - Permissions have three levels: full, limited, and none. - Native query download permissions are fully inferred from the non-native download permissions. For more details, see the docstring for [[metabase.models.permissions/update-native-download-permissions!]]. | (mu/defn update-db-download-permissions!
[group-id :- ms/PositiveInt db-id :- ms/PositiveInt new-download-perms :- perms/DownloadPermissionsGraph]
(when-not (premium-features/enable-advanced-permissions?)
(throw (perms/ee-permissions-exception :download)))
(when-let [schemas (:schemas new-download-perms)]
(condp = schemas
:full
(do
(revoke-download-permissions! group-id db-id)
(grant-permissions-for-all-schemas! :download :full group-id db-id))
:limited
(do
(revoke-download-permissions! group-id db-id)
(grant-permissions-for-all-schemas! :download :limited group-id db-id))
:none
(revoke-download-permissions! group-id db-id)
(when (map? schemas)
(doseq [[schema new-schema-perms] (seq schemas)]
(update-schema-download-permissions! group-id db-id schema new-schema-perms))))
;; We need to call update-native-download-permissions! whenever any download permissions are changed, but after we've
;; updated non-native donwload permissions. This is because native download permissions are fully computed from the
;; non-native download permissions.
(perms/update-native-download-permissions! group-id db-id))) |
+----------------------------------------------------------------------------------------------------------------+ | Data model permissions | +----------------------------------------------------------------------------------------------------------------+ | |
Returns the permissions path required to edit the data model for a table specified by | (defn data-model-write-perms-path [& path-components] (apply (partial perms/feature-perms-path :data-model :all) path-components)) |
(defn- update-table-data-model-permissions!
[group-id db-id schema table-id new-table-perms]
(condp = new-table-perms
:all
(do
(revoke-permissions! :data-model :all group-id db-id schema table-id)
(grant-permissions! :data-model :all group-id db-id schema table-id))
:none
(revoke-permissions! :data-model :all group-id db-id schema table-id))) | |
(defn- update-schema-data-model-permissions!
[group-id db-id schema new-schema-perms]
(condp = new-schema-perms
:all
(do
(revoke-permissions! :data-model :all group-id db-id schema)
(grant-permissions! :data-model :all group-id db-id schema))
:none
(revoke-permissions! :data-model :all group-id db-id schema)
(when (map? new-schema-perms)
(doseq [[table-id table-perms] new-schema-perms]
(update-table-data-model-permissions! group-id db-id schema table-id table-perms))))) | |
Update the data model permissions graph for a database. | (mu/defn update-db-data-model-permissions!
[group-id :- ms/PositiveInt db-id :- ms/PositiveInt new-data-model-perms :- perms/DataModelPermissionsGraph]
(when-not (premium-features/enable-advanced-permissions?)
(throw (perms/ee-permissions-exception :data-model)))
(when-let [schemas (:schemas new-data-model-perms)]
(condp = schemas
:all
(do
(revoke-permissions! :data-model :all group-id db-id)
(grant-permissions! :data-model :all group-id db-id))
:none
(revoke-permissions! :data-model :all group-id db-id)
(when (map? schemas)
(doseq [[schema new-schema-perms] (seq schemas)]
(update-schema-data-model-permissions! group-id db-id schema new-schema-perms)))))) |
+----------------------------------------------------------------------------------------------------------------+ | Data model permissions | +----------------------------------------------------------------------------------------------------------------+ | |
Returns the permissions path required to edit the database details for the provided database ID.
This is a simple wrapper around | (defn db-details-write-perms-path [db-id] (perms/feature-perms-path :details :yes db-id)) |
Update the DB details permissions for a database. | (mu/defn update-db-details-permissions!
[group-id :- ms/PositiveInt db-id :- ms/PositiveInt new-perms :- perms/DetailsPermissions]
(when-not (premium-features/enable-advanced-permissions?)
(throw (perms/ee-permissions-exception :details)))
(case new-perms
:yes
(do
(revoke-permissions! :details :yes group-id db-id)
(grant-permissions! :details :yes group-id db-id))
:no
(revoke-permissions! :details :yes group-id db-id))) |
Update the DB details permissions for a database. | (mu/defn update-db-execute-permissions!
[group-id :- ms/PositiveInt db-id :- ms/PositiveInt new-perms :- perms/ExecutePermissions]
(when-not (premium-features/enable-advanced-permissions?)
(throw (perms/ee-permissions-exception :execute)))
(revoke-permissions! :execute :all group-id db-id)
(when (= new-perms :all)
(grant-permissions! :execute :all group-id db-id))) |
Code for generating and updating the Application Permission graph. See [[metabase.models.permissions]] for more details and for the code for generating and updating the data permissions graph. | (ns metabase-enterprise.advanced-permissions.models.permissions.application-permissions (:require [clojure.data :as data] [metabase.models :refer [ApplicationPermissionsRevision Permissions]] [metabase.models.application-permissions-revision :as a-perm-revision] [metabase.models.permissions :as perms] [metabase.util.honey-sql-2 :as h2x] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
---------------------------------------------------- Schemas ----------------------------------------------------- | |
(def ^:private GroupPermissionsGraph [:map-of [:enum :setting :monitoring :subscription] [:enum :yes :no]]) | |
(def ^:private ApplicationPermissionsGraph
[:map {:closed true}
[:revision :int]
[:groups [:map-of ms/PositiveInt GroupPermissionsGraph]]]) | |
-------------------------------------------------- Fetch Graph --------------------------------------------------- | |
Returns a map of group-id -> application permissions paths. Only groups that has at least one application permission enabled will be included. | (defn- group-id->permissions-set
[]
(let [application-permissions (t2/select Permissions
{:where [:or
[:= :object "/"]
[:like :object (h2x/literal "/application/%")]]})]
(into {} (for [[group-id perms] (group-by :group_id application-permissions)]
{group-id (set (map :object perms))})))) |
(defn- permission-for-type
[permissions-set perm-type]
(if (perms/set-has-full-permissions? permissions-set (perms/application-perms-path perm-type))
:yes
:no)) | |
(mu/defn permissions-set->application-perms :- GroupPermissionsGraph
"Get a map of all application permissions for a group."
[permission-set]
{:setting (permission-for-type permission-set :setting)
:monitoring (permission-for-type permission-set :monitoring)
:subscription (permission-for-type permission-set :subscription)}) | |
(mu/defn graph :- ApplicationPermissionsGraph
"Fetch a graph representing the application permissions status for groups that has at least one application permission enabled.
This works just like the function of the same name in `metabase.models.permissions`;
see also the documentation for that function."
[]
{:revision (a-perm-revision/latest-id)
:groups (into {} (for [[group-id perms] (group-id->permissions-set)]
{group-id (permissions-set->application-perms perms)}))}) | |
-------------------------------------------------- Update Graph -------------------------------------------------- | |
Perform update application permissions for a group-id. | (defn update-application-permissions!
[group-id changes]
(doseq [[perm-type perm-value] changes]
(case perm-value
:yes
(perms/grant-application-permissions! group-id perm-type)
:no
(perms/revoke-application-permissions! group-id perm-type)))) |
Update the application Permissions graph. This works just like [[metabase.models.permission/update-data-perms-graph!]], but for Application permissions; refer to that function's extensive documentation to get a sense for how this works. | (mu/defn update-graph!
[new-graph :- ApplicationPermissionsGraph]
(let [old-graph (graph)
old-perms (:groups old-graph)
new-perms (:groups new-graph)
[diff-old changes] (data/diff old-perms new-perms)]
(perms/log-permissions-changes diff-old changes)
(perms/check-revision-numbers old-graph new-graph)
(when (seq changes)
(t2/with-transaction [_conn]
(doseq [[group-id changes] changes]
(update-application-permissions! group-id changes))
(perms/save-perms-revision! ApplicationPermissionsRevision (:revision old-graph) (:groups old-graph) changes))))) |
(ns metabase-enterprise.advanced-permissions.models.permissions.block-permissions (:require [metabase.api.common :as api] [metabase.models.permissions :as perms] [metabase.public-settings.premium-features :as premium-features] [metabase.query-processor.error-type :as qp.error-type] [metabase.util.i18n :refer [tru]])) | |
(defn- current-user-has-block-permissions-for-database? [database-or-id] (contains? @api/*current-user-permissions-set* (perms/database-block-perms-path database-or-id))) | |
Assert that block permissions are not in effect for Database for a query that's only allowed to run because of Collection perms; throw an Exception if they are. Otherwise returns a keyword explaining why the check succeeded (this is mostly for test/debug purposes). The query is still allowed to run if the current User has appropriate data permissions from another Group. See the namespace documentation for [[metabase.models.collection]] for more details. Note that this feature is Metabase© Enterprise Edition™ only and only enabled if we have a valid Enterprise Edition™ token. [[metabase.query-processor.middleware.permissions/check-block-permissions]] invokes this function if it exists. | (defn check-block-permissions
[{database-id :database}]
(cond
(not (premium-features/enable-advanced-permissions?))
::advanced-permissions-not-enabled
(not (current-user-has-block-permissions-for-database? database-id))
::no-block-permissions-for-db
:else
;; TODO -- come up with a better error message.
(throw (ex-info (tru "Blocked: you are not allowed to run queries against Database {0}." database-id)
{:type qp.error-type/missing-required-permissions
:actual-permissions @api/*current-user-permissions-set*
:permissions-error? true})))) |
(ns metabase-enterprise.advanced-permissions.models.permissions.group-manager (:require [clojure.data :as data] [clojure.set :as set] [metabase.api.common :as api] [metabase.models :refer [PermissionsGroupMembership]] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [toucan2.core :as t2])) | |
Return a list of group memberships a User belongs to. Group Membership is a map with 2 keys [:id :isgroupmanager]. | (defn user-group-memberships
[user-or-id]
(when user-or-id
(t2/select [PermissionsGroupMembership [:group_id :id] :is_group_manager] :user_id (u/the-id user-or-id)))) |
Transform user-group-memberships to a map in which keys are group-ids and values are maps containing membership info. [{:id 1, :isgroupmanager true}] => {1 {:isgroupmanager true}} We can diff this map to decide which membership to add/remove. | (defn- user-group-memberships->map
[user-group-memberships]
(into {} (map (fn [x] [(:id x) (dissoc x :id)]) user-group-memberships))) |
Update Groups Memberships of a User when | (defn set-user-group-memberships!
[user-or-id new-user-group-memberships]
(let [user-id (u/the-id user-or-id)
old-user-group-memberships (user-group-memberships user-id)
old-group-id->membership-info (user-group-memberships->map old-user-group-memberships)
new-group-id->membership-info (user-group-memberships->map new-user-group-memberships)
[to-remove to-add] (data/diff old-group-id->membership-info new-group-id->membership-info)
to-remove-group-ids (keys to-remove)
to-add-group-ids (keys to-add)]
;; TODO: Should do this check in the API layer
(when-not api/*is-superuser?*
;; prevent groups manager from update membership of groups that they're not manager of
(when-not (and api/*is-group-manager?*
(set/subset? (set (concat to-remove-group-ids to-add-group-ids))
(t2/select-fn-set :group_id PermissionsGroupMembership
:user_id api/*current-user-id* :is_group_manager true)))
(throw (ex-info (tru "Not allowed to edit group memberships")
{:status-code 403}))))
(t2/with-transaction [_conn]
(when (seq to-remove-group-ids)
(t2/delete! PermissionsGroupMembership :user_id user-id, :group_id [:in to-remove-group-ids]))
(when (seq to-add-group-ids)
;; do multiple single inserts because insert-many! does not call post-insert! hook
(doseq [group-id to-add-group-ids]
(t2/insert! PermissionsGroupMembership
{:user_id user-id
:group_id group-id
:is_group_manager (:is_group_manager (new-group-id->membership-info group-id))})))))) |
(ns metabase-enterprise.advanced-permissions.query-processor.middleware.permissions
(:require
[clojure.string :as str]
[metabase.api.common :as api]
[metabase.models.permissions :as perms]
[metabase.models.query.permissions :as query-perms]
[metabase.public-settings.premium-features
:as premium-features
:refer [defenterprise]]
[metabase.query-processor.error-type :as qp.error-type]
[metabase.util.i18n :refer [tru]])) | |
(def ^:private max-rows-in-limited-downloads 10000) | |
Returns true if this query is being used to generate a CSV/JSON/XLSX export. | (defn- is-download? [query] (some-> query :info :context name (str/includes? "download"))) |
Given a table-id referenced by a query, returns the permissions path required to download the results of the query
at the level specified by | (defn- table->download-perms-path
[db-id table-id download-level]
(first
(query-perms/tables->permissions-path-set
db-id
#{table-id}
{:table-perms-fn (fn [& path-components] (apply perms/feature-perms-path :download download-level path-components))
:native-perms-fn (fn [db-id] (perms/native-feature-perms-path :download download-level db-id))}))) |
Given a table-id referenced by a query, returns the level at which the current user can download the data in the table (:full, :limited or :none). | (defn- table-id->download-perms-level
[db-id table-id]
(cond (perms/set-has-full-permissions? @api/*current-user-permissions-set* (table->download-perms-path db-id table-id :full))
:full
(perms/set-has-full-permissions? @api/*current-user-permissions-set* (table->download-perms-path db-id table-id :limited))
:limited
:else
:none)) |
(defmulti ^:private current-user-download-perms-level :type) | |
(defmethod current-user-download-perms-level :default [_] :full) | |
(defmethod current-user-download-perms-level :native
[{database :database}]
(cond
(perms/set-has-full-permissions? @api/*current-user-permissions-set* (perms/native-feature-perms-path :download :full database))
:full
(perms/set-has-full-permissions? @api/*current-user-permissions-set* (perms/native-feature-perms-path :download :limited database))
:limited
:else
:none)) | |
(defmethod current-user-download-perms-level :query
[{db-id :database, :as query}]
;; Remove the :native key (containing the transpiled MBQL) so that this helper function doesn't think the query is
;; a native query. Actual native queries are dispatched to a different method by the :type key.
(let [table-ids (query-perms/query->source-table-ids (dissoc query :native))]
;; The download perm level for a query should be equal to the lowest perm level of any table referenced by the query.
(reduce (fn [lowest-seen-perm-level table-id]
(let [table-perm-level (table-id->download-perms-level db-id table-id)]
(cond
(= table-perm-level :none)
(reduced :none)
(or (= lowest-seen-perm-level :limited)
(= table-perm-level :limited))
:limited
:else
:full)))
:full
table-ids))) | |
Pre-processing middleware to apply row limits to MBQL export queries if the user has | (defenterprise apply-download-limit
:feature :advanced-permissions
[{query-type :type, {original-limit :limit} :query, :as query}]
(if (and (is-download? query)
(= query-type :query)
(= (current-user-download-perms-level query) :limited))
(assoc-in query
[:query :limit]
(apply min (filter some? [original-limit max-rows-in-limited-downloads])))
query)) |
Post-processing middleware to limit the number of rows included in downloads if the user has | (defenterprise limit-download-result-rows
:feature :advanced-permissions
[query rff]
(if (and (is-download? query)
(= (current-user-download-perms-level query) :limited))
(fn limit-download-result-rows* [metadata]
((take max-rows-in-limited-downloads) (rff metadata)))
rff)) |
Middleware for queries that generate downloads, which checks that the user has permissions to download the results of the query, and aborts the query or limits the number of results if necessary. If this query is not run to generate an export (e.g. :export-format is :api) we return user's download permissions in the query metadata so that the frontend can determine whether to show the download option on the UI. | (defenterprise check-download-permissions
:feature :advanced-permissions
[qp]
(fn [query rff context]
(let [download-perms-level (if api/*current-user-permissions-set*
(current-user-download-perms-level query)
;; If no user is bound, assume full download permissions (e.g. for public questions)
:full)]
(when (and (is-download? query)
(= download-perms-level :none))
(throw (ex-info (tru "You do not have permissions to download the results of this query.")
{:type qp.error-type/missing-required-permissions
:permissions-error? true})))
(qp query
(fn [metadata] (rff (some-> metadata (assoc :download_perms download-perms-level))))
context)))) |
API routes that are only available when running Metabase® Enterprise Edition™. Even tho these routes are available, not all routes might work unless we have a valid premium features token to enable those features. These routes should generally live under prefixes like | (ns metabase-enterprise.api.routes
(:require
[compojure.core :as compojure]
[metabase-enterprise.advanced-config.api.logs :as logs]
[metabase-enterprise.advanced-permissions.api.routes
:as advanced-permissions]
[metabase-enterprise.api.routes.common :as ee.api.common]
[metabase-enterprise.audit-app.api.routes :as audit-app]
[metabase-enterprise.content-verification.api.routes
:as content-verification]
[metabase-enterprise.sandbox.api.routes :as sandbox]
[metabase-enterprise.serialization.api :as api.serialization]
[metabase.util.i18n :refer [deferred-tru]])) |
API routes only available when running Metabase® Enterprise Edition™. | (compojure/defroutes routes
;; The following routes are NAUGHTY and do not follow the naming convention (i.e., they do not start with
;; `/ee/<feature>/`).
;;
;; TODO -- Please fix them! See #22687
content-verification/routes
sandbox/routes
;; The following routes are NICE and do follow the `/ee/<feature>/` naming convention. Please add new routes here
;; and follow the convention.
(compojure/context
"/ee" []
(compojure/context
"/audit-app" []
(ee.api.common/+require-premium-feature :audit-app (deferred-tru "Audit app") audit-app/routes))
(compojure/context
"/advanced-permissions" []
(ee.api.common/+require-premium-feature :advanced-permissions (deferred-tru "Advanced Permissions") advanced-permissions/routes))
(compojure/context
"/logs" []
(ee.api.common/+require-premium-feature :audit-app (deferred-tru "Audit app") logs/routes))
(compojure/context
"/serialization" []
(ee.api.common/+require-premium-feature :serialization (deferred-tru "Serialization") api.serialization/routes)))) |
Shared stuff used by various EE-only API routes. | (ns metabase-enterprise.api.routes.common (:require [metabase.public-settings.premium-features :as premium-features] [metabase.util.i18n :as i18n])) |
Wraps Ring (context "/whatever" [] (+require-premium-feature :sandboxes (deferred-tru "Sandboxes") whatever/routes)) Very important! Make sure you only wrap handlers inside [[compojure.core/context]] forms with this middleware (as in example above). Otherwise it can end up causing requests the handler would not have handled anyway to fail. Use [[when-premium-feature]] instead if you want the handler to apply if we have the premium feature but pass-thru if we do not. | (defn +require-premium-feature
[feature feature-name handler]
(assert (i18n/localized-string? feature-name), "`feature-name` must be i18ned")
(fn [request respond raise]
(premium-features/assert-has-feature feature feature-name)
(handler request respond raise))) |
Wraps Ring (+when-premium-feature :sandboxes (+auth table/routes)) This is typically used to replace OSS versions of API endpoints with special implementations that live in EE-land. If the endpoint only exists in EE you should use [[+require-premium-feature]] instead which will give the API user a useful error message if the endpoint is not available because they do not have the token feature in question, rather than a generic 'endpoint does not exist' 404 error. In general, it's probably better NOT to swap out API endpoints, because it's not obvious at all that it happened, and it makes it hard for us to nicely structure our contexts in [[metabase-enterprise.api.routes/routes]]. So only do this if there's absolutely no other way (which is probably not the case). | (defn ^:deprecated +when-premium-feature
[feature handler]
(fn [request respond raise]
(if-not (premium-features/has-feature? feature)
(respond nil)
(handler request respond raise)))) |
API endpoints that are only enabled if we have a premium token with the | (ns metabase-enterprise.audit-app.api.routes (:require [compojure.core :as compojure] [metabase-enterprise.audit-app.api.user :as user] [metabase.api.routes.common :refer [+auth]])) |
Ring routes for mt API endpoints. | (compojure/defroutes routes (compojure/context "/user" [] (+auth user/routes))) |
| (ns metabase-enterprise.audit-app.api.user (:require [compojure.core :refer [DELETE]] [metabase.api.common :as api] [metabase.api.user :as api.user] [metabase.models.pulse :refer [Pulse]] [metabase.models.pulse-channel-recipient :refer [PulseChannelRecipient]] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
/:id/subscriptions | (api/defendpoint DELETE
"Delete all Alert and DashboardSubscription subscriptions for a User (i.e., so they will no longer receive them).
Archive all Alerts and DashboardSubscriptions created by the User. Only allowed for admins or for the current user."
[id]
{id ms/PositiveInt}
(api.user/check-self-or-superuser id)
;; delete all `PulseChannelRecipient` rows for this User, which means they will no longer receive any
;; Alerts/DashboardSubscriptions
(t2/delete! PulseChannelRecipient :user_id id)
;; archive anything they created.
(t2/update! Pulse {:creator_id id, :archived false} {:archived true})
api/generic-204-no-content) |
(api/define-routes) | |
(ns metabase-enterprise.audit-app.interface (:require [metabase.plugins.classloader :as classloader] [metabase.util.i18n :refer [tru]] [metabase.util.malli.schema :as ms])) | |
Schema for the expected format for | (def ResultsMetadata
[:sequential
{:min 1}
[:tuple
ms/KeywordOrString
[:map
[:base_type ms/FieldType]
[:display_name ms/NonBlankString]]]]) |
Define a new internal query type. Conventionally | (defmulti internal-query
{:arglists '([query-type & args])}
(fn [query-type & _]
(keyword query-type))) |
(defmethod internal-query :default
[query-type & _]
(throw (ex-info (str (tru "Unable to run internal query function: cannot resolve {0}" query-type))
{:status-code 400}))) | |
Invoke the internal query with | (defn resolve-internal-query
[query-type & args]
(let [query-type (keyword query-type)
ns-str (namespace query-type)]
(when ns-str
(classloader/require (symbol ns-str)))
(apply internal-query query-type args))) |
(ns metabase-enterprise.audit-app.pages.alerts (:require [clojure.string :as str] [metabase-enterprise.audit-app.interface :as audit.i] [metabase-enterprise.audit-app.pages.common :as common] [metabase-enterprise.audit-app.pages.common.pulses :as common.pulses] [metabase.util :as u])) | |
(def ^:private table-metadata
(into
[[:card_id {:display_name "Question ID", :base_type :type/Integer, :remapped_to :card_name}]
[:card_name {:display_name "Question Name" :base_type :type/Text, :remapped_from :card_id}]]
common.pulses/table-metadata)) | |
(def ^:private table-query-columns
(into
[:card_id
:card_name]
common.pulses/table-query-columns)) | |
(defn- table-query [card-name]
(-> common.pulses/table-query
(update :select (partial into
[[:card.id :card_id]
[:card.name :card_name]]))
(update :left-join into [:pulse_card [:= :pulse.id :pulse_card.pulse_id]
[:report_card :card] [:= :pulse_card.card_id :card.id]])
(update :where (fn [where]
(into
where
(filter some?)
;; make sure the pulse_card actually exists.
[[:not= :pulse_card.card_id nil]
[:= :pulse.dashboard_id nil]
;; if `pulse.alert_condition` is non-NULL then the Pulse is an Alert
[:not= :pulse.alert_condition nil]
(when-not (str/blank? card-name)
[:like [:lower :card.name] (str \% (u/lower-case-en card-name) \%)])])))
(assoc :order-by [[[:lower :card.name] :asc]
;; Newest first. ID instead of `created_at` because the column is currently only
;; second-resolution for MySQL which busts our tests
[:channel.id :desc]]))) | |
(def ^:private ^{:arglists '([row-map])} row-map->vec
(apply juxt (map first table-metadata))) | |
(defn- post-process-row [row]
(-> (zipmap table-query-columns row)
common.pulses/post-process-row-map
row-map->vec)) | |
with optional param | (defmethod audit.i/internal-query ::table
([query-type]
(audit.i/internal-query query-type nil))
([_ card-name]
{:metadata table-metadata
:results (common/reducible-query (table-query card-name))
:xform (map post-process-row)})) |
Shared functions used by audit internal queries across different namespaces. | (ns metabase-enterprise.audit-app.pages.common
(:require
[clojure.core.async :as a]
[clojure.core.memoize :as memoize]
[clojure.walk :as walk]
[honey.sql :as sql]
[honey.sql.helpers :as sql.helpers]
[java-time.api :as t]
[medley.core :as m]
[metabase-enterprise.audit-app.query-processor.middleware.handle-audit-queries
:as qp.middleware.audit]
[metabase.db :as mdb]
[metabase.db.connection :as mdb.connection]
[metabase.db.query :as mdb.query]
[metabase.driver.sql-jdbc.execute :as sql-jdbc.execute]
[metabase.driver.sql-jdbc.sync :as sql-jdbc.sync]
[metabase.driver.sql.query-processor :as sql.qp]
[metabase.query-processor.context :as qp.context]
[metabase.query-processor.timezone :as qp.timezone]
[metabase.util :as u]
[metabase.util.honey-sql-2 :as h2x]
[metabase.util.i18n :refer [tru]]
[metabase.util.urls :as urls])) |
(set! *warn-on-reflection* true) | |
(def ^:private ^:const default-limit Integer/MAX_VALUE) | |
(defn- add-default-params [honeysql-query]
(let [{:keys [limit offset]} qp.middleware.audit/*additional-query-params*]
(if (and (nil? limit) (nil? offset))
honeysql-query
(-> honeysql-query
(update :limit (fn [query-limit]
[:inline (or limit query-limit default-limit)]))
(update :offset (fn [query-offset]
[:inline (or offset query-offset 0)])))))) | |
(defn- inject-cte-body-into-from
[from ctes]
(vec
(for [source from]
(if (vector? source)
(let [[source alias] source]
[(ctes source source) alias])
(if (ctes source)
[(ctes source) source]
source))))) | |
(defn- inject-cte-body-into-join
[joins ctes]
(->> joins
(partition 2)
(mapcat (fn [[source condition]]
(if (vector? source)
(let [[source alias] source]
[(if (ctes source)
[(ctes source) alias]
[source alias])
condition])
[(if (ctes source)
[(ctes source) source]
source)
condition])))
vec)) | |
(defn- CTEs->subselects
([query] (CTEs->subselects query {}))
([{:keys [with] :as query} ctes]
(let [ctes (reduce (fn [ctes [alias definition]]
(assoc ctes alias (CTEs->subselects definition ctes)))
ctes
with)]
(walk/postwalk
(fn [form]
(if (map? form)
(-> form
(m/update-existing :from inject-cte-body-into-from ctes)
;; TODO -- make this work with all types of joins
(m/update-existing :left-join inject-cte-body-into-join ctes)
(m/update-existing :join inject-cte-body-into-join ctes))
form))
(dissoc query :with))))) | |
TODO - fixme | (def ^:private ^{:arglists '([])} application-db-default-timezone
;; cache the application DB's default timezone for an hour. I don't expect this information to change *ever*,
;; really, but it seems like it is possible that it *could* change. Determining this for every audit query seems
;; wasteful however.
;;
;; This is cached by db-type and the JDBC connection spec in case that gets changed/swapped out for one reason or
;; another
(let [timezone (memoize/ttl
#_{:clj-kondo/ignore [:deprecated-var]}
sql-jdbc.sync/db-default-timezone
:ttl/threshold (u/hours->ms 1))]
(fn []
(timezone (mdb/db-type) {:datasource mdb.connection/*application-db*})))) |
(defn- compile-honeysql [driver honeysql-query]
(try
(let [honeysql-query (cond-> honeysql-query
;; MySQL 5.x does not support CTEs, so convert them to subselects instead
(= driver :mysql) CTEs->subselects)]
(mdb.query/compile (add-default-params honeysql-query)))
(catch Throwable e
(throw (ex-info (tru "Error compiling audit query: {0}" (ex-message e))
{:driver driver, :honeysql-query honeysql-query}
e))))) | |
(defn- reduce-results* [honeysql-query context rff init]
(let [driver (mdb/db-type)
[sql & params] (compile-honeysql driver honeysql-query)
canceled-chan (qp.context/canceled-chan context)]
;; MySQL driver normalizies timestamps. Setting `*results-timezone-id-override*` is a shortcut
;; instead of mocking up a chunk of regular QP pipeline.
(binding [qp.timezone/*results-timezone-id-override* (application-db-default-timezone)]
(try
(with-open [conn (.getConnection mdb.connection/*application-db*)
stmt (sql-jdbc.execute/prepared-statement driver conn sql params)
rs (sql-jdbc.execute/execute-prepared-statement! driver stmt)]
(let [rsmeta (.getMetaData rs)
cols (for [col (sql-jdbc.execute/column-metadata driver rsmeta)]
(update col :name u/lower-case-en))
metadata {:cols cols}
rf (rff metadata)]
(reduce rf init (sql-jdbc.execute/reducible-rows driver rs rsmeta canceled-chan))))
(catch InterruptedException e
(a/>!! canceled-chan :cancel)
(throw e))
(catch Throwable e
(throw (ex-info (tru "Error running audit query: {0}" (ex-message e))
{:driver driver
:honeysql-query honeysql-query
:sql sql
:params params}
e))))))) | |
Return a function with the signature (f context) -> IReduceInit that, when reduced, runs | (defn reducible-query
[honeysql-query]
(bound-fn reducible-query-fn [context]
(reify clojure.lang.IReduceInit
(reduce [_ rf init]
(reduce-results* honeysql-query context (constantly rf) init))))) |
Run a internal audit query, automatically including limits and offsets for paging. This function returns results
directly as a series of maps (the 'legacy results' format as described in
| (defn query
[honeysql-query]
(let [context {:canceled-chan (a/promise-chan)}
rff (fn [{:keys [cols]}]
(let [col-names (mapv (comp keyword :name) cols)]
((map (partial zipmap col-names)) conj)))]
(try
(reduce-results* honeysql-query context rff [])
(catch InterruptedException e
(a/>!! (:canceled-chan context) ::cancel)
(throw e))))) |
+----------------------------------------------------------------------------------------------------------------+ | Helper Fns | +----------------------------------------------------------------------------------------------------------------+ | |
HoneySQL to grab the full name of a User. (user-full-name :u) ;; -> 'Cam Saul' | (defn user-full-name
[user-table]
(let [first-name (keyword (name user-table) "first_name")
last-name (keyword (name user-table) "last_name")
email (keyword (name user-table) "email")]
[:case
[:and [:= nil first-name] [:= nil last-name]]
email
[:or [:= nil first-name] [:= nil last-name]]
(h2x/concat [:coalesce first-name ""] [:coalesce last-name ""])
:else
(h2x/concat [:coalesce first-name ""] (h2x/literal " ") [:coalesce last-name ""])])) |
Map of datetime unit strings (possible params for queries that accept a datetime | (def datetime-unit-str->base-type
{"quarter" :type/Date
"day" :type/Date
"hour" :type/DateTime
"week" :type/Date
"default" :type/DateTime
"day-of-week" :type/Integer
"hour-of-day" :type/Integer
"month" :type/Date
"month-of-year" :type/Integer
"day-of-month" :type/Integer
"year" :type/Integer
"day-of-year" :type/Integer
"week-of-year" :type/Integer
"quarter-of-year" :type/Integer
"minute-of-hour" :type/Integer
"minute" :type/DateTime}) |
Scheme for a valid QP DateTime unit as a string (the format they will come into the audit QP). E.g. something
like | (def DateTimeUnitStr (into [:enum] (keys datetime-unit-str->base-type))) |
Group a datetime expression by (grouped-datetime :day :timestamp) ;; -> | (defn grouped-datetime [unit expr] (sql.qp/date (mdb/db-type) (keyword unit) expr)) |
Build a | (defn first-non-null
[& exprs]
(into [:case]
(mapcat (fn [expr] [[:not= expr nil] expr]))
exprs)) |
Build a | (defn zero-if-null [expr] [:case [:not= expr nil] expr :else 0]) |
Lowercase a SQL field, to enter into honeysql query | (defn lowercase-field [field] [:lower field]) |
Add an appropriate | (defn add-45-days-clause
[query date_column]
(sql.helpers/where query [:>
(h2x/cast :date date_column)
(h2x/cast :date (h2x/literal (t/format "yyyy-MM-dd" (t/minus (t/local-date) (t/days 45)))))])) |
Add an appropriate (add-search-clause {} "birds" :t.name :db.name) | (defn add-search-clause
[query query-string & fields-to-search]
(sql.helpers/where query (when (seq query-string)
(let [query-string (str \% (u/lower-case-en query-string) \%)]
(cons
:or
(for [field fields-to-search]
[:like (lowercase-field field) query-string])))))) |
Add an Most queries will just have explicit default | (defn add-sort-clause [query sort-column sort-direction] (sql.helpers/order-by query [(keyword sort-column) (keyword sort-direction)])) |
Return HoneySQL for a | (defn card-public-url [field] [:case [:not= field nil] (h2x/concat (urls/public-card-prefix) field)]) |
Return HoneySQL for a | (defn native-or-gui [query-execution-table] [:case [:= (keyword (name query-execution-table) "native") true] (h2x/literal "Native") :else (h2x/literal "GUI")]) |
HoneySQL for a | (defn card-name-or-ad-hoc [card-table] (first-non-null (keyword (name card-table) "name") (h2x/literal "Ad-hoc"))) |
HoneySQL for a | (defn query-execution-is-download
[query-execution-table]
[:in (keyword (name query-execution-table) "context") #{"csv-download" "xlsx-download" "json-download"}]) |
(defn- format-separator
[_separator [x y]]
(let [[x-sql & x-args] (sql/format-expr x {:nested true})
[y-sql & y-args] (sql/format-expr y {:nested true})]
(into [(format "%s SEPARATOR %s" x-sql y-sql)]
cat
[x-args
y-args]))) | |
(sql/register-fn! ::separator format-separator) | |
Portable MySQL | (defn group-concat
[expr separator]
(if (= (mdb/db-type) :mysql)
[:group_concat [::separator expr (h2x/literal separator)]]
[:string_agg expr (h2x/literal separator)])) |
Common queries used by both Card (Question) and Dashboard detail pages. | (ns metabase-enterprise.audit-app.pages.common.card-and-dashboard-detail (:require [metabase-enterprise.audit-app.pages.common :as common] [metabase.models.card :refer [Card]] [metabase.models.dashboard :refer [Dashboard]] [metabase.models.revision :as revision] [metabase.util.honey-sql-2 :as h2x] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms])) |
(def ^:private ModelName [:enum "card" "dashboard"]) | |
Get views of a Card or Dashboard broken out by a time SELECT {{group-fn(timestamp}} AS "date", count(*) AS views FROM view_log WHERE model = {{model}} AND model_id = {{model-id}} GROUP BY {{group-fn(timestamp}} ORDER BY {{group-fn(timestamp}} ASC | (mu/defn views-by-time
[model :- ModelName
model-id :- ms/PositiveInt
unit :- common/DateTimeUnitStr]
{:metadata [[:date {:display_name "Date", :base_type (common/datetime-unit-str->base-type unit)}]
[:views {:display_name "Views", :base_type :type/Integer}]]
:results (let [grouped-timestamp (common/grouped-datetime unit :timestamp)]
(common/reducible-query
(-> {:select [[grouped-timestamp :date]
[:%count.* :views]]
:from [:view_log]
:where [:and
[:= :model (h2x/literal model)]
[:= :model_id model-id]]
:group-by [grouped-timestamp]
:order-by [[grouped-timestamp :asc]]}
(common/add-45-days-clause :timestamp))))}) |
Get number of views of a Card broken out by a time | (mu/defn cached-views-by-time
[card-id :- ms/PositiveInt
unit :- common/DateTimeUnitStr]
{:metadata [[:date {:display_name "Date",
:base_type (common/datetime-unit-str->base-type unit)}]
[:cached-views {:display_name "Cached Views",
:base_type :type/Integer}]
[:uncached-views {:display_name "Uncached Views",
:base_type :type/Integer}]]
:results (let [grouped-timestamp (common/grouped-datetime unit :started_at)]
(common/reducible-query
(->
{:select [[grouped-timestamp :date]
[[:sum [:case [:= :cache_hit true] [:inline 1] :else [:inline 0]]] :cached_views]
[[:sum [:case [:= :cache_hit false] [:inline 1] :else [:inline 0]]] :uncached_views]]
:from [:query_execution]
:where [:and
[:= :card_id card-id]
[:not= :cache_hit nil]]
:group-by [grouped-timestamp]
:order-by [[grouped-timestamp :asc]]}
(common/add-45-days-clause :started_at))))}) |
Get average execution time of a Card broken out by a time | (mu/defn avg-execution-time-by-time
[card-id :- ms/PositiveInt
unit :- common/DateTimeUnitStr]
{:metadata [[:date {:display_name "Date", :base_type (common/datetime-unit-str->base-type unit)}]
[:avg_runtime {:display_name "Average Runtime", :base_type :type/Number}]]
:results (let [grouped-timestamp (common/grouped-datetime unit :started_at)]
(common/reducible-query
(-> {:select [[grouped-timestamp :date]
[[:avg :running_time] :avg_runtime]]
:from [:query_execution]
:where [:= :card_id card-id]
:group-by [grouped-timestamp]
:order-by [[grouped-timestamp :asc]]}
(common/add-45-days-clause :started_at))))}) |
Get a revision history table for a Card or Dashboard. | (mu/defn revision-history
[model :- [:enum Card Dashboard]
model-id :- ms/PositiveInt]
{:metadata [[:timestamp {:display_name "Edited on", :base_type :type/DateTime}]
[:user_id {:display_name "User ID", :base_type :type/Integer, :remapped_to :user_name}]
[:user_name {:display_name "Edited by", :base_type :type/Name, :remapped_from :user_id}]
[:change_made {:display_name "Change made", :base_type :type/Text}]
[:revision_id {:display_name "Revision ID", :base_type :type/Integer}]]
:results (for [revision (revision/revisions+details model model-id)]
{:timestamp (-> revision :timestamp)
:user_id (-> revision :user :id)
:user_name (-> revision :user :common_name)
:change_made (-> revision :description)
:revision_id (-> revision :id)})}) |
Get a view log for a Card or Dashboard. | (mu/defn audit-log
[model :- ModelName
model-id :- ms/PositiveInt]
{:metadata [[:when {:display_name "When", :base_type :type/DateTime}]
[:user_id {:display_name "User ID", :base_type :type/Integer, :remapped_to :who}]
[:who {:display_name "Who", :base_type :type/Name, :remapped_from :user_id}]
[:what {:display_name "What", :base_type :type/Text}]]
:results (common/reducible-query
{:select [[:vl.timestamp :when]
:vl.user_id
[(common/user-full-name :u) :who]
[:vl.metadata :what]]
:from [[:view_log :vl]]
:join [[:core_user :u] [:= :vl.user_id :u.id]]
:where [:and
[:= :model (h2x/literal model)]
[:= :model_id model-id]]
:order-by [[:vl.timestamp :desc]
[[:lower :u.last_name] :asc]
[[:lower :u.first_name] :asc]]})}) |
(ns metabase-enterprise.audit-app.pages.common.cards (:require [metabase-enterprise.audit-app.pages.common :as common] [metabase.db.connection :as mdb.connection] [metabase.util.honey-sql-2 :as h2x])) | |
HoneySQL for a CTE to include the average execution time for each Card. | (def avg-exec-time
[:avg_exec_time {:select [:card_id
[:%avg.running_time :avg_running_time_ms]]
:from [:query_execution]
:group-by [:card_id]}]) |
HoneySQL for a CTE to include the average execution time for each Card for 45 days. | (def avg-exec-time-45
[:avg_exec_time_45 (-> {:select [:card_id
[:%avg.running_time :avg_running_time_ms]]
:from [:query_execution]
:group-by [:card_id]}
(common/add-45-days-clause :started_at))]) |
HoneySQL for a CTE to include the total execution time for each Card for 45 days. | (def total-exec-time-45
[:total_runtime_45 (-> {:select [:card_id
[:%sum.running_time :total_running_time_ms]]
:from [:query_execution]
:group-by [:card_id]}
(common/add-45-days-clause :started_at))]) |
HoneySQL for a CTE to get latest QueryExecution for a Card. | (def latest-qe
[:latest_qe {:select [:query_execution.card_id :error :query_execution.started_at]
:from [:query_execution]
:join [[{:select [:card_id [:%max.started_at :started_at]]
:from [:query_execution]
:group-by [:card_id]} :inner_qe]
[:= :query_execution.started_at :inner_qe.started_at]]}]) |
HoneySQL for a CTE to include the total number of queries for each Card forever. | (def query-runs
[:query_runs {:select [:card_id
[:%count.* :count]]
:from [:query_execution]
:group-by [:card_id]}]) |
HoneySQL for a CTE to include the total number of queries for each Card for 45 days. | (def query-runs-45
[:query_runs (-> {:select [:card_id
[:%count.* :count]]
:from [:query_execution]
:group-by [:card_id]}
(common/add-45-days-clause :started_at))]) |
HoneySQL for a CTE to enumerate the dashboards for a Card. | (def dashboards-count
[:dash_card {:select [:card_id [:%count.* :count]]
:from [:report_dashboardcard]
:group-by [:card_id]}]) |
HoneySQL for a CTE to enumerate the dashboards for a Card. We get the actual ID's | (def dashboards-ids
[:dash_card {:select [:card_id [(common/group-concat (h2x/cast
(if (= (mdb.connection/db-type) :mysql) :char :text)
:report_dashboard.name)
"|")
:name_str]]
:from [:report_dashboardcard]
:join [:report_dashboard [:= :report_dashboardcard.dashboard_id :report_dashboard.id]]
:group-by [:card_id]}]) |
HoneySQL for a CTE to include the total view count for each Card. | (def views
[:card_views {:select [[:model_id :card_id]
[:%count.* :count]]
:from [:view_log]
:where [:= :model (h2x/literal "card")]
:group-by [:model_id]}]) |
(ns metabase-enterprise.audit-app.pages.common.dashboards (:require [honey.sql.helpers :as sql.helpers] [metabase-enterprise.audit-app.pages.common :as common] [metabase.config :as config] [metabase.util.honey-sql-2 :as h2x] [metabase.util.urls :as urls])) | |
Dashboard table! | (defn table
[query-string & [where-clause]]
{:metadata [[:dashboard_id {:display_name "Dashboard ID", :base_type :type/Integer, :remapped_to :title}]
[:title {:display_name "Title", :base_type :type/Title, :remapped_from :dashboard_id}]
[:saved_by_id {:display_name "Saved by User ID", :base_type :type/Text, :remapped_to :saved_by}]
[:saved_by {:display_name "Saved by", :base_type :type/Text, :remapped_from :saved_by_id}]
[:saved_on {:display_name "Saved on", :base_type :type/DateTime}]
[:cache_ttl {:display_name "Cache Duration", :base_type :type/Integer}]
[:last_edited_on {:display_name "Last edited on", :base_type :type/DateTime}]
[:cards {:display_name "Cards", :base_type :type/Integer}]
[:public_link {:display_name "Public Link", :base_type :type/URL}]
[:average_execution_time_ms {:display_name "Avg. exec. time (ms)", :base_type :type/Decimal}]
[:total_views {:display_name "Total views", :base_type :type/Integer}]]
:results (common/reducible-query
(->
{:with [[:card_count {:select [:dashboard_id
[:%count.* :card_count]]
:from [:report_dashboardcard]
:group-by [:dashboard_id]}]
[:card_avg_execution_time {:select [:card_id
[:%avg.running_time :avg_running_time]]
:from [:query_execution]
:where [:not= :card_id nil]
:group-by [:card_id]}]
[:avg_execution_time {:select [:dc.dashboard_id
[[:avg :cxt.avg_running_time] :avg_running_time]]
:from [[:report_dashboardcard :dc]]
:left-join [[:card_avg_execution_time :cxt] [:= :dc.card_id :cxt.card_id]]
:group-by [:dc.dashboard_id]}]
[:views {:select [[:model_id :dashboard_id]
[:%count.* :view_count]]
:from [:view_log]
:where [:= :model (h2x/literal "dashboard")]
:group-by [:model_id]}]]
:select [[:d.id :dashboard_id]
[:d.name :title]
[:u.id :saved_by_id]
[(common/user-full-name :u) :saved_by]
[:d.created_at :saved_on]
[:d.cache_ttl :saved_on]
[:d.updated_at :last_edited_on]
[:cc.card_count :cards]
[[:case
[:not= :d.public_uuid nil]
(h2x/concat (urls/public-dashboard-prefix) :d.public_uuid)]
:public_link]
[:axt.avg_running_time :average_execution_time_ms]
[:v.view_count :total_views]]
:from [[:report_dashboard :d]]
:left-join [[:core_user :u] [:= :d.creator_id :u.id]
[:card_count :cc] [:= :d.id :cc.dashboard_id]
[:avg_execution_time :axt] [:= :d.id :axt.dashboard_id]
[:views :v] [:= :d.id :v.dashboard_id]]
:where [:not= :d.creator_id config/internal-mb-user-id]
:order-by [[[:lower :d.name] :asc]
[:dashboard_id :asc]]}
(common/add-search-clause query-string :d.name)
(sql.helpers/where where-clause)))}) |
Shared code for [[metabase-enterprise.audit-app.pages.dashboard-subscriptions]] and [[metabase-enterprise.audit-app.pages.alerts]]. | (ns metabase-enterprise.audit-app.pages.common.pulses (:require [cheshire.core :as json] [metabase.models.collection :as collection] [metabase.util.cron :as u.cron] [metabase.util.honey-sql-2 :as h2x] [metabase.util.i18n :refer [trs tru]] [metabase.util.log :as log])) |
Common Metadata for the columns returned by both the [[metabase-enterprise.audit-app.pages.dashboard-subscriptions]] and [[metabase-enterprise.audit-app.pages.alerts]] audit queries. (These respective queries also return their own additional columns.) | (def table-metadata
[[:pulse_id {:display_name "Pulse ID", :base_type :type/Integer}]
[:recipients {:display_name "Recipients", :base_type :type/Integer}]
[:subscription_type {:display_name "Type", :base_type :type/Text}]
[:collection_id {:display_name "Collection ID", :base_type :type/Integer, :remapped_to :collection_name}]
[:collection_name {:display_name "Collection", :base_type :type/Text, :remapped_from :collection_id}]
[:frequency {:display_name "Frequency", :base_type :type/Text}]
[:creator_id {:display_name "Created By ID", :base_type :type/Integer, :remapped_to :creator_name}]
[:creator_name {:display_name "Created By", :base_type :type/Text, :remapped_from :creator_id}]
[:created_at {:display_name "Created At", :base_type :type/DateTimeWithTZ}]
[:num_filters {:display_name "Filters", :base_type :type/Integer}]]) |
Keyword names of columns returned by the queries by both the [[metabase-enterprise.audit-app.pages.dashboard-subscriptions]] and [[metabase-enterprise.audit-app.pages.alerts]] audit queries. | (def table-query-columns [:pulse_id :num_user_recipients :channel_id :channel_details :subscription_type :collection_id :collection_name :schedule_type :schedule_hour :schedule_day :schedule_frame :creator_id :creator_name :created_at :pulse_parameters]) |
Common HoneySQL base query for both the [[metabase-enterprise.audit-app.pages.dashboard-subscriptions]] and [[metabase-enterprise.audit-app.pages.alerts]] audit queries. (The respective implementations tweak this query and add additional columns, filters, and order-by clauses.) | (def table-query
{:with [[:user_recipients {:select [[:recipient.pulse_channel_id :channel_id]
[:%count.* :count]]
:from [[:pulse_channel_recipient :recipient]]
:group-by [:channel_id]}]]
:select [[:pulse.id :pulse_id]
[:user_recipients.count :num_user_recipients]
[:channel.id :channel_id]
[:channel.details :channel_details]
[:channel.channel_type :subscription_type]
[:collection.id :collection_id]
[:collection.name :collection_name]
:channel.schedule_type
:channel.schedule_hour
:channel.schedule_day
:channel.schedule_frame
[:creator.id :creator_id]
[(h2x/concat :creator.first_name (h2x/literal " ") :creator.last_name) :creator_name]
[:channel.created_at :created_at]
[:pulse.parameters :pulse_parameters]]
:from [[:pulse_channel :channel]]
:left-join [:pulse [:= :channel.pulse_id :pulse.id]
:collection [:= :pulse.collection_id :collection.id]
[:core_user :creator] [:= :pulse.creator_id :creator.id]
:user_recipients [:= :channel.id :user_recipients.channel_id]]
:where [:and
[:not= :pulse.archived true]
[:= :channel.enabled true]]}) |
(defn- describe-frequency [row]
(-> (select-keys row [:schedule_type :schedule_hour :schedule_day :schedule_frame])
u.cron/schedule-map->cron-string
u.cron/describe-cron-string)) | |
Return the number of recipients for email | (defn- describe-recipients
[{subscription-type :subscription_type
channel-details :channel_details
num-recipients :num_user_recipients}]
(let [details (json/parse-string channel-details true)]
(when (= (keyword subscription-type) :email)
((fnil + 0 0) num-recipients (count (:emails details)))))) |
(defn- pulse-parameter-count [{pulse-parameters :pulse_parameters}]
(if-let [params (try
(some-> pulse-parameters (json/parse-string true))
(catch Throwable e
(log/error e (trs "Error parsing Pulse parameters: {0}" (ex-message e)))
nil))]
(count params)
0)) | |
(defn- root-collection-name [] (:name (collection/root-collection-with-ui-details nil))) | |
Post-process a (zipmap table-query-columns row-vector) This map should contain at least the keys in [[table-query-columns]] (provided by the common [[table-query]]). After calling this function, you'll need to convert the row map back to a vector; something like (apply juxt (map first table-metadata)) should do the trick. | (defn post-process-row-map
[row]
{:pre [(map? row)]}
(-> row
(assoc :frequency (describe-frequency row)
:recipients (describe-recipients row)
:num_filters (pulse-parameter-count row))
(update :subscription_type (fn [subscription-type]
(case (keyword subscription-type)
:email (tru "Email")
:slack (tru "Slack")
subscription-type)))
(update :collection_name #(or % (root-collection-name))))) |
Detail page for a single dashboard. | (ns metabase-enterprise.audit-app.pages.dashboard-detail
(:require
[metabase-enterprise.audit-app.interface :as audit.i]
[metabase-enterprise.audit-app.pages.common :as common]
[metabase-enterprise.audit-app.pages.common.card-and-dashboard-detail
:as card-and-dash-detail]
[metabase-enterprise.audit-app.pages.common.cards :as cards]
[metabase.models.dashboard :refer [Dashboard]]
[metabase.models.permissions :as perms]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms])) |
Get views of a Dashboard broken out by a time | (mu/defmethod audit.i/internal-query ::views-by-time [_query-type dashboard-id :- ms/PositiveInt datetime-unit :- common/DateTimeUnitStr] (card-and-dash-detail/views-by-time "dashboard" dashboard-id datetime-unit)) |
Revision history for a specific Dashboard. | (mu/defmethod audit.i/internal-query ::revision-history [_query-type dashboard-id :- ms/PositiveInt] (card-and-dash-detail/revision-history Dashboard dashboard-id)) |
View log for a specific Dashboard. | (mu/defmethod audit.i/internal-query ::audit-log [_query-type dashboard-id :- ms/PositiveInt] (card-and-dash-detail/audit-log "dashboard" dashboard-id)) |
Information about the Saved Questions (Cards) in this instance. | (mu/defmethod audit.i/internal-query ::cards
[_query-type dashboard-id :- ms/PositiveInt]
{:metadata [[:card_id {:display_name "Card ID", :base_type :type/Integer, :remapped_to :card_name}]
[:card_name {:display_name "Title", :base_type :type/Name, :remapped_from :card_id}]
[:collection_id {:display_name "Collection ID", :base_type :type/Integer, :remapped_to :collection_name}]
[:collection_name {:display_name "Collection", :base_type :type/Text, :remapped_from :collection_id}]
[:created_at {:display_name "Created At", :base_type :type/DateTime}]
[:database_id {:display_name "Database ID", :base_type :type/Integer, :remapped_to :database_name}]
[:database_name {:display_name "Database", :base_type :type/Text, :remapped_from :database_id}]
[:table_id {:display_name "Table ID", :base_type :type/Integer, :remapped_to :table_name}]
[:table_name {:display_name "Table", :base_type :type/Text, :remapped_from :table_id}]
[:avg_running_time_ms {:display_name "Avg. exec. time (ms)", :base_type :type/Number}]
[:cache_ttl {:display_name "Cache Duration", :base_type :type/Number}]
[:public_link {:display_name "Public Link", :base_type :type/URL}]
[:total_views {:display_name "Total Views", :base_type :type/Integer}]]
:results (common/reducible-query
{:with [[:card {:select [:card.*
[:dc.created_at :dashcard_created_at]]
:from [[:report_dashboardcard :dc]]
:join [[:report_card :card] [:= :card.id :dc.card_id]]
:where [:and
[:= :dc.dashboard_id dashboard-id]
[:not= :card.database_id perms/audit-db-id]]}]
cards/avg-exec-time
cards/views]
:select [[:card.id :card_id]
[:card.name :card_name]
[:coll.id :collection_id]
[:coll.name :collection_name]
[:card.dashcard_created_at :created_at]
:card.database_id
[:db.name :database_name]
:card.table_id
[:t.name :table_name]
:avg_exec_time.avg_running_time_ms
[(common/card-public-url :card.public_uuid) :public_link]
:card.cache_ttl
[:card_views.count :total_views]]
:from [:card]
:left-join [:avg_exec_time [:= :card.id :avg_exec_time.card_id]
[:metabase_database :db] [:= :card.database_id :db.id]
[:metabase_table :t] [:= :card.table_id :t.id]
[:collection :coll] [:= :card.collection_id :coll.id]
:card_views [:= :card.id :card_views.card_id]]
:order-by [[[:lower :card.name] :asc]]})}) |
(ns metabase-enterprise.audit-app.pages.dashboard-subscriptions (:require [clojure.string :as str] [metabase-enterprise.audit-app.interface :as audit.i] [metabase-enterprise.audit-app.pages.common :as common] [metabase-enterprise.audit-app.pages.common.pulses :as common.pulses] [metabase.util :as u])) | |
(def ^:private table-metadata
(into
[[:dashboard_id {:display_name "Dashboard ID", :base_type :type/Integer, :remapped_to :dashboard_name}]
[:dashboard_name {:display_name "Dashboard Name" :base_type :type/Text, :remapped_from :dashboard_id}]]
common.pulses/table-metadata)) | |
(def ^:private table-query-columns
(into
[:dashboard_id
:dashboard_name]
common.pulses/table-query-columns)) | |
(defn- table-query [dashboard-name]
(-> common.pulses/table-query
(update :select (partial into
[[:dashboard.id :dashboard_id]
[:dashboard.name :dashboard_name]]))
(update :left-join into [[:report_dashboard :dashboard] [:= :pulse.dashboard_id :dashboard.id]])
(update :where (fn [where]
(into
where
(filter some?)
[[:not= :pulse.dashboard_id nil]
(when-not (str/blank? dashboard-name)
[:like [:lower :dashboard.name] (str \% (u/lower-case-en dashboard-name) \%)])])))
(assoc :order-by [[[:lower :dashboard.name] :asc]
;; Newest first. ID instead of `created_at` because the column is currently only
;; second-resolution for MySQL which busts our tests
[:channel.id :desc]]))) | |
(def ^:private ^{:arglists '([row-map])} row-map->vec
(apply juxt (map first table-metadata))) | |
(defn- post-process-row [row]
(-> (zipmap table-query-columns row)
common.pulses/post-process-row-map
row-map->vec)) | |
with optional param | (defmethod audit.i/internal-query ::table
([query-type]
(audit.i/internal-query query-type nil))
([_ dashboard-name]
{:metadata table-metadata
:results (common/reducible-query (table-query dashboard-name))
:xform (map post-process-row)})) |
Dashboards overview page. | (ns metabase-enterprise.audit-app.pages.dashboards (:require [metabase-enterprise.audit-app.interface :as audit.i] [metabase-enterprise.audit-app.pages.common :as common] [metabase-enterprise.audit-app.pages.common.dashboards :as dashboards] [metabase.config :as config] [metabase.util.honey-sql-2 :as h2x] [metabase.util.malli :as mu])) |
Two-series timeseries that includes total number of Dashboard views and saves broken out by a | (mu/defmethod audit.i/internal-query ::views-and-saves-by-time
[_query-type datetime-unit :- common/DateTimeUnitStr]
{:metadata [[:date {:display_name "Date", :base_type (common/datetime-unit-str->base-type datetime-unit)}]
[:views {:display_name "Views", :base_type :type/Integer}]
[:saves {:display_name "Saves", :base_type :type/Integer}]]
;; this is so nice and easy to implement in a single query with FULL OUTER JOINS but unfortunately only pg supports
;; them(!)
:results (let [views (common/query
{:select [[(common/grouped-datetime datetime-unit :timestamp) :date]
[:%count.* :views]]
:from [[:view_log :vl]]
:left-join [[:report_dashboard :d] [:= :vl.model_id :d.id]]
:where [:and
[:= :model (h2x/literal "dashboard")]
[:not= :d.creator_id config/internal-mb-user-id]]
:group-by [(common/grouped-datetime datetime-unit :timestamp)]})
date->views (zipmap (map :date views) (map :views views))
saves (common/query
{:select [[(common/grouped-datetime datetime-unit :created_at) :date]
[:%count.* :saves]]
:from [[:report_dashboard :d]]
:where [:not= :d.creator_id config/internal-mb-user-id]
:group-by [(common/grouped-datetime datetime-unit :created_at)]})
date->saves (zipmap (map :date saves) (map :saves saves))
all-dates (sort (keep identity (distinct (concat (keys date->views)
(keys date->saves)))))]
(for [date all-dates]
{:date date
:views (date->views date 0)
:saves (date->saves date 0)}))}) |
DEPRECATED Use | (defmethod audit.i/internal-query ::most-popular
[_]
{:metadata [[:dashboard_id {:display_name "Dashboard ID", :base_type :type/Integer, :remapped_to :dashboard_name}]
[:dashboard_name {:display_name "Dashboard", :base_type :type/Title, :remapped_from :dashboard_id}]
[:views {:display_name "Views", :base_type :type/Integer}]]
:results (common/reducible-query
{:select [[:d.id :dashboard_id]
[:d.name :dashboard_name]
[:%count.* :views]]
:from [[:view_log :vl]]
:left-join [[:report_dashboard :d] [:= :vl.model_id :d.id]]
:where [:and
[:= :vl.model (h2x/literal "dashboard")]
[:not= :d.creator_id config/internal-mb-user-id]]
:group-by [:d.id]
:order-by [[:%count.* :desc]]
:limit 10})}) |
Ten most popular dashboards with their average speed. | (defmethod audit.i/internal-query ::most-popular-with-avg-speed
[_]
{:metadata [[:dashboard_id {:display_name "Dashboard ID", :base_type :type/Integer, :remapped_to :dashboard_name}]
[:dashboard_name {:display_name "Dashboard", :base_type :type/Title, :remapped_from :dashboard_id}]
[:views {:display_name "Views", :base_type :type/Integer}]
[:avg_running_time {:display_name "Avg. Question Load Time (ms)", :base_type :type/Decimal}]]
:results (common/reducible-query
{:with [[:most_popular {:select [[:d.id :dashboard_id]
[:d.name :dashboard_name]
[:%count.* :views]
[:d.creator_id :creator_id]]
:from [[:view_log :vl]]
:left-join [[:report_dashboard :d] [:= :vl.model_id :d.id]]
:where [:= :vl.model (h2x/literal "dashboard")]
:group-by [:d.id]
:order-by [[:%count.* :desc]]
:limit [:inline 10]}]
[:card_running_time {:select [:qe.card_id
[[:avg :qe.running_time] :avg_running_time]]
:from [[:query_execution :qe]]
:where [:not= :qe.card_id nil]
:group-by [:qe.card_id]}]
[:dash_avg_running_time {:select [[:d.id :dashboard_id]
[[:avg :rt.avg_running_time] :avg_running_time]]
:from [[:report_dashboardcard :dc]]
:left-join [[:card_running_time :rt] [:= :dc.card_id :rt.card_id]
[:report_dashboard :d] [:= :dc.dashboard_id :d.id]]
:group-by [:d.id]
:where [:in :d.id {:select [:dashboard_id]
:from [:most_popular]}]}]]
:select [:mp.dashboard_id
:mp.dashboard_name
:mp.views
:rt.avg_running_time]
:from [[:most_popular :mp]]
:left-join [[:dash_avg_running_time :rt] [:= :mp.dashboard_id :rt.dashboard_id]]
:where [:not= :mp.creator_id config/internal-mb-user-id]
:order-by [[:mp.views :desc]]
:limit 10})}) |
DEPRECATED Query that returns the 10 Dashboards that have the slowest average execution times, in descending order. | (defmethod audit.i/internal-query ::slowest
[_]
{:metadata [[:dashboard_id {:display_name "Dashboard ID", :base_type :type/Integer, :remapped_to :dashboard_name}]
[:dashboard_name {:display_name "Dashboard", :base_type :type/Title, :remapped_from :dashboard_id}]
[:avg_running_time {:display_name "Avg. Question Load Time (ms)", :base_type :type/Decimal}]]
:results (common/reducible-query
{:with [[:card_running_time {:select [:qe.card_id
[[:avg :qe.running_time] :avg_running_time]]
:from [[:query_execution :qe]]
:where [:not= :qe.card_id nil]
:group-by [:qe.card_id]}]]
:select [[:d.id :dashboard_id]
[:d.name :dashboard_name]
[[:avg :rt.avg_running_time] :avg_running_time]]
:from [[:report_dashboardcard :dc]]
:left-join [[:card_running_time :rt] [:= :dc.card_id :rt.card_id]
[:report_dashboard :d] [:= :dc.dashboard_id :d.id]]
:where [:not= :d.creator_id config/internal-mb-user-id]
:group-by [:d.id]
:order-by [[:avg_running_time :desc]]
:limit 10})}) |
DEPRECATED Query that returns the 10 Cards that appear most often in Dashboards, in descending order. | (defmethod audit.i/internal-query ::most-common-questions
[_]
{:metadata [[:card_id {:display_name "Card ID", :base_type :type/Integer, :remapped_to :card_name}]
[:card_name {:display_name "Card", :base_type :type/Title, :remapped_from :card_id}]
[:count {:display_name "Count", :base_type :type/Integer}]]
:results (common/reducible-query
{:select [[:c.id :card_id]
[:c.name :card_name]
[:%count.* :count]]
:from [[:report_dashboardcard :dc]]
:join [[:report_card :c] [:= :c.id :dc.card_id]]
:where [:not= :c.creator_id config/internal-mb-user-id]
:group-by [:c.id]
:order-by [[:%count.* :desc]]
:limit 10})}) |
Internal audit app query powering a table of different Dashboards with lots of extra info about them. | (mu/defmethod audit.i/internal-query ::table ([query-type] (audit.i/internal-query query-type nil)) ([_query-type query-string :- [:maybe :string]] (dashboards/table query-string))) |
(ns metabase-enterprise.audit-app.pages.database-detail (:require [metabase-enterprise.audit-app.interface :as audit.i] [metabase-enterprise.audit-app.pages.common :as common] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [ring.util.codec :as codec])) | |
Query execution history for queries against this Database. | (mu/defmethod audit.i/internal-query ::audit-log
[_query-type database-id :- ms/PositiveInt]
{:metadata [[:started_at {:display_name "Viewed on", :base_type :type/DateTime}]
[:card_id {:display_name "Card ID", :base_type :type/Integer, :remapped_to :query}]
[:query_hash {:display_name "Query Hash", :base_type :type/Text}]
[:query {:display_name "Query", :base_type :type/Text, :remapped_from :card_id}]
[:user_id {:display_name "User ID", :base_type :type/Integer, :remapped_to :user}]
[:user {:display_name "Queried by", :base_type :type/Text, :remapped_from :user_id}]
[:schema {:display_name "Schema", :base_type :type/Text}]
[:table_id {:display_name "Table ID", :base_type :type/Integer, :remapped_to :table}]
[:table {:display_name "Table", :base_type :type/Text, :remapped_from :table_id}]]
:results (common/reducible-query
{:select [:qe.started_at
[:card.id :card_id]
[:qe.hash :query_hash]
[(common/card-name-or-ad-hoc :card) :query]
[:u.id :user_id]
[(common/user-full-name :u) :user]
:t.schema
[:t.id :table_id]
[:t.name :table]]
:from [[:query_execution :qe]]
:where [:= :qe.database_id database-id]
:join [[:metabase_database :db] [:= :db.id :qe.database_id]
[:core_user :u] [:= :qe.executor_id :u.id]]
:left-join [[:report_card :card] [:= :qe.card_id :card.id]
[:metabase_table :t] [:= :card.table_id :t.id]]
:order-by [[:qe.started_at :desc]]})
:xform (map #(update (vec %) 2 codec/base64-encode))}) |
(ns metabase-enterprise.audit-app.pages.databases (:require [metabase-enterprise.audit-app.interface :as audit.i] [metabase-enterprise.audit-app.pages.common :as common] [metabase.models.permissions :as perms] [metabase.util.cron :as u.cron] [metabase.util.honey-sql-2 :as h2x] [metabase.util.malli :as mu])) | |
SELECT db.id AS database_id, db.name AS database_name, count(*) AS queries, avg(qe.runningtime) AS avgrunning_time FROM query_execution qe JOIN reportcard card ON qe.cardid = card.id JOIN metabasetable t ON card.tableid = t.id JOIN metabasedatabase db ON t.dbid = db.id WHERE db.id != audit-db-id GROUP BY db.id ORDER BY lower(db.name) ASC DEPRECATED Return Databases with the total number of queries ran against them and the average running time for all queries. | (defmethod audit.i/internal-query ::total-query-executions-by-db
[_]
{:metadata [[:database_id {:display_name "Database ID", :base_type :type/Integer, :remapped_to :database_name}]
[:database_name {:display_name "Database", :base_type :type/Text, :remapped_from :database_id}]
[:queries {:display_name "Queries", :base_type :type/Integer}]
[:avg_running_time {:display_name "Avg. Running Time (ms)", :base_type :type/Decimal}]]
:results (common/reducible-query
{:select [[:db.id :database_id]
[:db.name :database_name]
[:%count.* :queries]
[[:avg :qe.running_time] :avg_running_time]]
:from [[:query_execution :qe]]
:join [[:report_card :card] [:= :qe.card_id :card.id]
[:metabase_table :t] [:= :card.table_id :t.id]
[:metabase_database :db] [:= :t.db_id :db.id]]
:where [:not= :db.id perms/audit-db-id]
:group-by [:db.id]
:order-by [[[:lower :db.name] :asc]]})}) |
Query that returns count of query executions grouped by Database and a | (mu/defmethod audit.i/internal-query ::query-executions-by-time
[_query-type datetime-unit :- common/DateTimeUnitStr]
{:metadata [[:date {:display_name "Date", :base_type (common/datetime-unit-str->base-type datetime-unit)}]
[:database_id {:display_name "Database ID", :base_type :type/Integer, :remapped_to :database_name}]
[:database_name {:display_name "Database Name", :base_type :type/Name, :remapped_from :database_id}]
[:count {:display_name "Count", :base_type :type/Integer}]]
:results (common/reducible-query
{:with [[:qx {:select [[(common/grouped-datetime datetime-unit :qe.started_at) :date]
:card.database_id
[:%count.* :count]]
:from [[:query_execution :qe]]
:left-join [[:report_card :card] [:= :qe.card_id :card.id]]
:where [:and
[:not= :qe.card_id nil]
[:not= :card.database_id nil]
[:not= :card.database_id perms/audit-db-id]]
:group-by [(common/grouped-datetime datetime-unit :qe.started_at) :card.database_id]
:order-by [[(common/grouped-datetime datetime-unit :qe.started_at) :asc]
[:card.database_id :asc]]}]]
:select [:qx.date
:qx.database_id
[:db.name :database_name]
:qx.count]
:from [:qx]
:left-join [[:metabase_database :db] [:= :qx.database_id :db.id]]
:order-by [[:qx.date :asc]
[[:lower :db.name] :asc]
[:qx.database_id :asc]]})}) |
DEPRECATED Use | (defmethod audit.i/internal-query ::query-executions-per-db-per-day [_] (audit.i/internal-query ::query-executions-by-time "day")) |
Table with information and statistics about all the data warehouse Databases in this Metabase instance. | (mu/defmethod audit.i/internal-query ::table
([query-type]
(audit.i/internal-query query-type nil))
([_query-type query-string :- [:maybe :string]]
;; TODO - Should we convert sync_schedule from a cron string into English? Not sure that's going to be feasible for
;; really complicated schedules
{:metadata [[:database_id {:display_name "Database ID", :base_type :type/Integer, :remapped_to :title}]
[:title {:display_name "Title", :base_type :type/Text, :remapped_from :database_id}]
[:added_on {:display_name "Added On", :base_type :type/DateTime}]
[:sync_schedule {:display_name "Sync Schedule", :base_type :type/Text}]
[:schemas {:display_name "Schemas", :base_type :type/Integer}]
[:tables {:display_name "Tables", :base_type :type/Integer}]
[:cache_ttl {:display_name "Cache Duration", :base_type :type/Integer}]]
:results (common/reducible-query
(->
{:with [[:counts {:select [[:db_id :id]
[[::h2x/distinct-count :schema] :schemas]
[:%count.* :tables]]
:from [:metabase_table]
:group-by [:db_id]}]]
:select [[:db.id :database_id]
[:db.name :title]
[:db.created_at :added_on]
[:db.metadata_sync_schedule :sync_schedule]
[:counts.schemas :schemas]
[:counts.tables :tables]
[:db.cache_ttl :cache_ttl]]
:from [[:metabase_database :db]]
:left-join [:counts [:= :db.id :counts.id]]
:where [:not= :db.id perms/audit-db-id]
:order-by [[[:lower :db.name] :asc]
[:database_id :asc]]}
(common/add-search-clause query-string :db.name)))
:xform (map #(update (vec %) 3 u.cron/describe-cron-string))})) |
Audit queries returning info about query downloads. Query downloads are any query executions whose results are returned as CSV/JSON/XLS. | (ns metabase-enterprise.audit-app.pages.downloads (:require [metabase-enterprise.audit-app.interface :as audit.i] [metabase-enterprise.audit-app.pages.common :as common] [metabase.db :as mdb] [metabase.driver.sql.query-processor :as sql.qp] [metabase.models.permissions :as perms] [metabase.util.honey-sql-2 :as h2x])) |
(set! *warn-on-reflection* true) | |
Pairs of count of rows downloaded and date downloaded for the 1000 largest (in terms of row count) queries over the past 30 days. Intended to power scatter plot. | (defmethod audit.i/internal-query ::per-day-by-size
[_]
{:metadata [[:date {:display_name "Day", :base_type :type/DateTime}]
[:rows {:display_name "Rows in Query", :base_type :type/Integer}]
[:user_id {:display_name "User ID", :base_type :type/Integer, :remapped_to :user_name}]
[:user_name {:display_name "User", :base_type :type/Text, :remapped_from :user_id}]]
:results (common/reducible-query
{:select [[:qe.started_at :date]
[:qe.result_rows :rows]
[:qe.executor_id :user_id]
[(common/user-full-name :u) :user_name]]
:from [[:query_execution :qe]]
:left-join [[:core_user :u] [:= :qe.executor_id :u.id]]
:where [:and
[:> :qe.started_at (sql.qp/add-interval-honeysql-form (mdb/db-type) :%now -30 :day)]
(common/query-execution-is-download :qe)]
:order-by [[:qe.result_rows :desc]]
:limit 1000})}) |
Total count of query downloads broken out by user, ordered by highest total, for the top 10 users. | (defmethod audit.i/internal-query ::per-user
[_]
{:metadata [[:user_id {:display_name "User ID", :base_type :type/Integer, :remapped_to :user_name}]
[:user_name {:display_name "User", :base_type :type/Text, :remapped_from :user_id}]
[:downloads {:display_name "Downloads", :base_type :type/Integer}]]
:results (common/reducible-query
{:with [[:downloads_by_user
{:select [[:qe.executor_id :user_id]
[:%count.* :downloads]]
:from [[:query_execution :qe]]
:where (common/query-execution-is-download :qe)
:group-by [:qe.executor_id]
:order-by [[:%count.* :desc]]
:limit 10}]]
:select [[:d.user_id :user_id]
[(common/user-full-name :u) :user_name]
[:d.downloads :downloads]]
:from [[:downloads_by_user :d]]
:join [[:core_user :u] [:= :d.user_id :u.id]]
:order-by [[:d.downloads :desc]]})}) |
Add/remove numbers here to adjust buckets returned by the | (def ^:private bucket-maxes
[ 10
100
1000
5000
10000
50000
100000
500000
1000000]) |
CASE ... result_rows <= 100 THEN 100 ... | (def ^:private rows->bucket-case-expression
(into [:case] (concat
(mapcat (fn [bucket-max]
[[:<= :result_rows bucket-max] bucket-max])
bucket-maxes)
[:else -1]))) |
Pairs like [[0 10], [11 100], ...] | (def ^:private bucket-ranges
(reduce
(fn [acc bucket-max]
(conj acc [(or (some-> acc last last inc) 0) ; get min from last pair in acc or 0
bucket-max]))
[]
bucket-maxes)) |
Format number to string adding commas as thousands separators. | (defn- format-number-add-commas [^Number n] (.format (java.text.DecimalFormat. "#,###") n)) |
Given a bucket range pair like [101 1000] return a formatted string including commas like | (defn- bucket-range->literal [[bucket-min bucket-max]] (h2x/literal (format "%s-%s" (format-number-add-commas bucket-min) (format-number-add-commas bucket-max)))) |
CASE ... (rowsbucketmax = 1000) THEN '101-1,000' ... | (def ^:private bucket->range-str-case-expression
(into [:case] (concat
(mapcat (fn [[_ bucket-max :as bucket-range]]
[[:= :rows_bucket_max bucket-max] (bucket-range->literal bucket-range)])
bucket-ranges)
[[:= :rows_bucket_max -1]
(h2x/literal (format "> %s" (format-number-add-commas (last bucket-maxes))))]))) |
Query download count broken out by bucketed number of rows of query. E.g. 10 downloads of queries with 0-10 rows, 15 downloads of queries with 11-100, etc. Intended to power bar chart. | (defmethod audit.i/internal-query ::by-size
[_]
{:metadata [[:rows {:display_name "Rows Downloaded", :base_type :type/Text}]
[:downloads {:display_name "Downloads", :base_type :type/Integer}]]
:results (common/reducible-query
{:with [[:bucketed_downloads
{:select [[rows->bucket-case-expression :rows_bucket_max]]
:from [:query_execution]
:where [:and
(common/query-execution-is-download :query_execution)
[:not= :result_rows nil]]}]]
:select [[bucket->range-str-case-expression :rows]
[:%count.* :downloads]]
:from [:bucketed_downloads]
:group-by [:rows_bucket_max]
:order-by [[:rows_bucket_max :asc]]})}) |
Table showing all query downloads ordered by most recent. | (defmethod audit.i/internal-query ::table
[_]
{:metadata [[:downloaded_at {:display_name "Downloaded At", :base_type :type/DateTime}]
[:rows_downloaded {:display_name "Rows Downloaded", :base_type :type/Integer}]
[:card_id {:display_name "Card ID", :base_type :type/Integer, :remapped_to :card_name}]
[:card_name {:display_name "Query", :base_type :type/Text, :remapped_from :card_id}]
[:query_type {:display_name "Query Type", :base_type :type/Text}]
[:database_id {:display_name "Database ID", :base_type :type/Integer, :remapped_to :database}]
[:database {:display_name "Database", :base_type :type/Text, :remapped_from :database_id}]
[:source_table_id {:display_name "Source Table ID", :base_type :type/Integer, :remapped_to :source_table}]
[:source_table {:display_name "Source Table", :base_type :type/Text, :remapped_from :source_table_id}]
[:user_id {:display_name "User ID", :base_type :type/Integer, :remapped_to :user_name}]
[:user_name {:display_name "User", :base_type :type/Text, :remapped_from :user_id}]]
:results (common/reducible-query
{:select [[:qe.started_at :downloaded_at]
[:qe.result_rows :rows_downloaded]
[:card.id :card_id]
[(common/card-name-or-ad-hoc :card) :card_name]
[(common/native-or-gui :qe) :query_type]
[:db.id :database_id]
[:db.name :database]
[:t.id :source_table_id]
[:t.name :source_table]
[:qe.executor_id :user_id]
[(common/user-full-name :u) :user_name]]
:from [[:query_execution :qe]]
:left-join [[:report_card :card] [:= :card.id :qe.card_id]
[:metabase_database :db] [:= :qe.database_id :db.id]
[:metabase_table :t] [:= :card.table_id :t.id]
[:core_user :u] [:= :qe.executor_id :u.id]]
:where [:and
(common/query-execution-is-download :qe)
[:not= :card.database_id perms/audit-db-id]]
:order-by [[:qe.started_at :desc]]})}) |
(ns metabase-enterprise.audit-app.pages.queries (:require [metabase-enterprise.audit-app.interface :as audit.i] [metabase-enterprise.audit-app.pages.common :as common] [metabase-enterprise.audit-app.pages.common.cards :as cards] [metabase.db.connection :as mdb.connection] [metabase.models.permissions :as perms] [metabase.util.honey-sql-2 :as h2x])) | |
DEPRECATED Query that returns data for a two-series timeseries chart with number of queries ran and average query running time broken out by day. | (defmethod audit.i/internal-query ::views-and-avg-execution-time-by-day
[_]
{:metadata [[:day {:display_name "Date", :base_type :type/Date}]
[:views {:display_name "Views", :base_type :type/Integer}]
[:avg_running_time {:display_name "Avg. Running Time (ms)", :base_type :type/Decimal}]]
:results (common/reducible-query
{:select [[(h2x/cast :date :started_at) :day]
[:%count.* :views]
[[:avg :running_time] :avg_running_time]]
:from [:query_execution]
:group-by [(h2x/cast :date :started_at)]
:order-by [[(h2x/cast :date :started_at) :asc]]})}) |
Query that returns the 10 most-popular Cards based on number of query executions, in descending order. | (defmethod audit.i/internal-query ::most-popular
[_]
{:metadata [[:card_id {:display_name "Card ID", :base_type :type/Integer, :remapped_to :card_name}]
[:card_name {:display_name "Card", :base_type :type/Title, :remapped_from :card_id}]
[:executions {:display_name "Executions", :base_type :type/Integer}]]
:results (common/reducible-query
{:select [[:c.id :card_id]
[:c.name :card_name]
[:%count.* :executions]]
:from [[:query_execution :qe]]
:join [[:report_card :c] [:= :qe.card_id :c.id]]
:group-by [:c.id]
:order-by [[:executions :desc]]
:limit 10})}) |
DEPRECATED Query that returns the 10 slowest-running Cards based on average query execution time, in descending order. | (defmethod audit.i/internal-query ::slowest
[_]
{:metadata [[:card_id {:display_name "Card ID", :base_type :type/Integer, :remapped_to :card_name}]
[:card_name {:display_name "Card", :base_type :type/Title, :remapped_from :card_id}]
[:avg_running_time {:display_name "Avg. Running Time (ms)", :base_type :type/Decimal}]]
:results (common/reducible-query
{:select [[:c.id :card_id]
[:c.name :card_name]
[[:avg :running_time] :avg_running_time]]
:from [[:query_execution :qe]]
:join [[:report_card :c] [:= :qe.card_id :c.id]]
:group-by [:c.id]
:order-by [[:avg_running_time :desc]]
:limit 10})}) |
List of all failing questions | (defmethod audit.i/internal-query ::bad-table
([_]
(audit.i/internal-query ::bad-table nil nil nil nil nil))
([_
error-filter
db-filter
collection-filter
sort-column
sort-direction]
{:metadata [[:card_id {:display_name "Card ID", :base_type :type/Integer :remapped_to :card_name}]
[:card_name {:display_name "Question", :base_type :type/Text :remapped_from :card_id}]
[:error_substr {:display_name "Error", :base_type :type/Text :code true}]
[:collection_id {:display_name "Collection ID", :base_type :type/Integer :remapped_to :collection_name}]
[:collection_name {:display_name "Collection", :base_type :type/Text :remapped_from :collection_id}]
[:database_id {:display_name "Database ID", :base_type :type/Integer :remapped_to :database_name}]
[:database_name {:display_name "Database", :base_type :type/Text :remapped_from :database_id}]
[:schema_name {:display_name "Schema", :base_type :type/Text}]
[:table_id {:display_name "Table ID", :base_type :type/Integer :remapped_to :table_name}]
[:table_name {:display_name "Table", :base_type :type/Text :remapped_from :table_id}]
[:last_run_at {:display_name "Last run at", :base_type :type/DateTime}]
[:total_runs {:display_name "Total runs", :base_type :type/Integer}]
;; if it appears a billion times each in 2 dashboards, that's 2 billion appearances
[:num_dashboards {:display_name "Dashboards it's in", :base_type :type/Integer}]
[:user_id {:display_name "Created By ID", :base_type :type/Integer :remapped_to :user_name}]
[:user_name {:display_name "Created By", :base_type :type/Text :remapped_from :user_id}]
[:updated_at {:display_name "Updated At", :base_type :type/DateTime}]]
:results (common/reducible-query
(let [coll-name [:coalesce :coll.name "Our Analytics"]
error-substr [:concat
[:substring
:latest_qe.error
[:inline (if (= (mdb.connection/db-type) :mysql) 1 0)]
[:inline 60]]
"..."]
dash-count [:coalesce :dash_card.count [:inline 0]]]
(->
{:with [cards/query-runs
cards/latest-qe
cards/dashboards-count]
:select [[:card.id :card_id]
[:card.name :card_name]
[error-substr :error_substr]
:collection_id
[coll-name :collection_name]
:card.database_id
[:db.name :database_name]
[:t.schema :schema_name]
:card.table_id
[:t.name :table_name]
[:latest_qe.started_at :last_run_at]
[:query_runs.count :total_runs]
[dash-count :num_dashboards]
[:card.creator_id :user_id]
[(common/user-full-name :u) :user_name]
[:card.updated_at :updated_at]]
:from [[:report_card :card]]
:left-join [[:collection :coll] [:= :card.collection_id :coll.id]
[:metabase_database :db] [:= :card.database_id :db.id]
[:metabase_table :t] [:= :card.table_id :t.id]
[:core_user :u] [:= :card.creator_id :u.id]
:latest_qe [:= :card.id :latest_qe.card_id]
:query_runs [:= :card.id :query_runs.card_id]
:dash_card [:= :card.id :dash_card.card_id]]
:where [:and
[:= :card.archived false]
[:<> :latest_qe.error nil]
[:not= :card.database_id perms/audit-db-id]]}
(common/add-search-clause error-filter :latest_qe.error)
(common/add-search-clause db-filter :db.name)
(common/add-search-clause collection-filter coll-name)
(common/add-sort-clause
(or sort-column "card.name")
(or sort-direction "asc")))))})) |
A list of all questions. Three possible argument lists. All arguments are always nullable.
Sort column is given over in keyword form to honeysql. Default Sort direction can be All inputs have to be strings because that's how the magic middleware that turns these functions into clojure-backed 'datasets' works. | (defmethod audit.i/internal-query ::table
([query-type]
(audit.i/internal-query query-type nil nil nil nil))
([query-type question-filter]
(audit.i/internal-query query-type question-filter nil nil nil))
([_
question-filter
collection-filter
sort-column
sort-direction]
{:metadata [[:card_id {:display_name "Card ID", :base_type :type/Integer, :remapped_to :card_name}]
[:card_name {:display_name "Name", :base_type :type/Name, :remapped_from :card_id}]
[:collection_id {:display_name "Collection ID", :base_type :type/Integer, :remapped_to :collection_name}]
[:collection_name {:display_name "Collection", :base_type :type/Text, :remapped_from :collection_id}]
[:database_id {:display_name "Database ID", :base_type :type/Integer, :remapped_to :database_name}]
[:database_name {:display_name "Database", :base_type :type/Text, :remapped_from :database_id}]
[:table_id {:display_name "Table ID", :base_type :type/Integer, :remapped_to :table_name}]
[:table_name {:display_name "Table", :base_type :type/Text, :remapped_from :table_id}]
[:user_id {:display_name "Created By ID", :base_type :type/Integer, :remapped_to :user_name}]
[:user_name {:display_name "Created By", :base_type :type/Text, :remapped_from :user_id}]
[:cache_ttl {:display_name "Cache Duration", :base_type :type/Integer}]
[:avg_exec_time {:display_name "Average Runtime (ms)", :base_type :type/Integer}]
[:total_runtime {:display_name "Total Runtime (ms)", :base_type :type/Integer}]
[:query_runs {:display_name "Query Runs", :base_type :type/Integer}]
[:public_link {:display_name "Public Link", :base_type :type/URL}]]
:results (common/reducible-query
(->
{:with [cards/avg-exec-time-45
cards/total-exec-time-45
cards/query-runs-45]
:select [[:card.id :card_id]
[:card.name :card_name]
:collection_id
[:coll.name :collection_name]
:card.database_id
[:db.name :database_name]
:card.table_id
[:t.name :table_name]
[:card.creator_id :user_id]
[(common/user-full-name :u) :user_name]
:card.cache_ttl
[:avg_exec_time_45.avg_running_time_ms :avg_exec_time]
[:total_runtime_45.total_running_time_ms :total_runtime]
[(common/zero-if-null :query_runs.count) :query_runs]
[(common/card-public-url :card.public_uuid) :public_link]]
:from [[:report_card :card]]
:left-join [[:collection :coll] [:= :card.collection_id :coll.id]
[:metabase_database :db] [:= :card.database_id :db.id]
[:metabase_table :t] [:= :card.table_id :t.id]
[:core_user :u] [:= :card.creator_id :u.id]
:avg_exec_time_45 [:= :card.id :avg_exec_time_45.card_id]
:total_runtime_45 [:= :card.id :total_runtime_45.card_id]
:query_runs [:= :card.id :query_runs.card_id]]
:where [:and
[:= :card.archived false]
[:not= :card.database_id perms/audit-db-id]]}
(common/add-search-clause question-filter :card.name)
(common/add-search-clause collection-filter :coll.name)
(common/add-sort-clause
(or sort-column "card.name")
(or sort-direction "asc"))))})) |
Queries to show details about a (presumably ad-hoc) query. | (ns metabase-enterprise.audit-app.pages.query-detail (:require [cheshire.core :as json] [metabase-enterprise.audit-app.interface :as audit.i] [metabase-enterprise.audit-app.pages.common :as common] [metabase-enterprise.audit-app.pages.common.cards :as cards] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [ring.util.codec :as codec])) |
(mu/defmethod audit.i/internal-query ::bad-card
[_query-type card-id :- ms/PositiveInt]
{:metadata [[:card_id {:display_name "Question ID", :base_type :type/Integer :remapped_from :card_name}]
[:card_name {:display_name "Question", :base_type :type/Text :remapped_from :card_id}]
[:error_str {:display_name "Error", :base_type :type/Text :code true}]
[:collection_id {:display_name "Collection ID", :base_type :type/Integer :remapped_to :collection_name}]
[:collection_name {:display_name "Collection", :base_type :type/Text :remapped_from :collection_id}]
[:database_id {:display_name "Database ID", :base_type :type/Integer :remapped_to :database_name}]
[:database_name {:display_name "Database", :base_type :type/Text :remapped_from :database_id}]
[:schema_name {:display_name "Schema", :base_type :type/Text}]
[:table_id {:display_name "Table ID", :base_type :type/Integer :remapped_to :table_name}]
[:table_name {:display_name "Table", :base_type :type/Text :remapped_from :table_id}]
[:last_run_at {:display_name "Last run at", :base_type :type/DateTime}]
[:total_runs {:display_name "Total runs", :base_type :type/Integer}]
;; Denormalize by string_agg in order to avoid having to deal with complicated left join
[:dash_name_str {:display_name "Dashboards it's in", :base_type :type/Text}]
[:user_id {:display_name "Created By ID", :base_type :type/Integer :remapped_to :user_name}]
[:user_name {:display_name "Created By", :base_type :type/Text :remapped_from :user_id}]
[:updated_at {:display_name "Updated At", :base_type :type/DateTime}]]
:results (common/reducible-query
{:with [cards/query-runs
cards/latest-qe
cards/dashboards-ids]
:select [[:card.id :card_id]
[:card.name :card_name]
[:latest_qe.error :error_str]
:collection_id
[[:coalesce :coll.name "Our Analytics"] :collection_name]
:card.database_id
[:db.name :database_name]
[:t.schema :schema_name]
:card.table_id
[:t.name :table_name]
[:latest_qe.started_at :last_run_at]
[:query_runs.count :total_runs]
[:dash_card.name_str :dash_name_str]
[:card.creator_id :user_id]
[(common/user-full-name :u) :user_name]
[:card.updated_at :updated_at]]
:from [[:report_card :card]]
:left-join [[:collection :coll] [:= :card.collection_id :coll.id]
[:metabase_database :db] [:= :card.database_id :db.id]
[:metabase_table :t] [:= :card.table_id :t.id]
[:core_user :u] [:= :card.creator_id :u.id]
:latest_qe [:= :card.id :latest_qe.card_id]
:query_runs [:= :card.id :query_runs.card_id]
:dash_card [:= :card.id :dash_card.card_id]]
:where [:= :card.id card-id]})}) | |
Details about a specific query (currently just average execution time). | (mu/defmethod audit.i/internal-query ::details
[_query-type query-hash :- ms/NonBlankString]
{:metadata [[:query {:display_name "Query", :base_type :type/Dictionary}]
[:average_execution_time {:display_name "Avg. Exec. Time (ms)", :base_type :type/Number}]]
:results (common/reducible-query
{:select [:query
:average_execution_time]
:from [:query]
:where [:= :query_hash (codec/base64-decode query-hash)]
:limit 1})
:xform (map #(update (vec %) 0 json/parse-string))}) |
Detail page for a single Card (Question). | (ns metabase-enterprise.audit-app.pages.question-detail
(:require
[metabase-enterprise.audit-app.interface :as audit.i]
[metabase-enterprise.audit-app.pages.common :as common]
[metabase-enterprise.audit-app.pages.common.card-and-dashboard-detail
:as card-and-dash-detail]
[metabase.models.card :refer [Card]]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms])) |
Get views of a Card broken out by a time | (mu/defmethod audit.i/internal-query ::views-by-time [_query-type card-id :- ms/PositiveInt datetime-unit :- common/DateTimeUnitStr] (card-and-dash-detail/views-by-time "card" card-id datetime-unit)) |
Get cached views of a Card broken out by a time | (mu/defmethod audit.i/internal-query ::cached-views-by-time [_query-type card-id :- ms/PositiveInt datetime-unit :- common/DateTimeUnitStr] (card-and-dash-detail/cached-views-by-time card-id datetime-unit)) |
Get the revision history for a Card. | (mu/defmethod audit.i/internal-query ::revision-history [_query-type card-id :- ms/PositiveInt] (card-and-dash-detail/revision-history Card card-id)) |
Get a view log for a Card. | (mu/defmethod audit.i/internal-query ::audit-log [_query-type card-id :- ms/PositiveInt] (card-and-dash-detail/audit-log "card" card-id)) |
Average execution time broken out by period | (mu/defmethod audit.i/internal-query ::avg-execution-time-by-time [_query-type card-id :- ms/PositiveInt datetime-unit :- common/DateTimeUnitStr] (card-and-dash-detail/avg-execution-time-by-time card-id datetime-unit)) |
(ns metabase-enterprise.audit-app.pages.schemas (:require [metabase-enterprise.audit-app.interface :as audit.i] [metabase-enterprise.audit-app.pages.common :as common] [metabase.models.permissions :as perms] [metabase.util.honey-sql-2 :as h2x] [metabase.util.malli :as mu])) | |
WITH counts AS ( SELECT db."name" AS dbname, t."schema" AS dbschema FROM query_execution qe LEFT JOIN report_card card ON qe.card_id = card.id LEFT JOIN metabase_database db ON card.database_id = db.id LEFT JOIN metabase_table t ON card.table_id = t.id WHERE qe.card_id IS NOT NULL AND card.database_id IS NOT NULL AND card.table_id IS NOT NULL AND db.id != audit-db-id ) SELECT (dbname || ' ' || dbschema) AS "schema", count(*) AS executions FROM counts GROUP BY dbname, dbschema ORDER BY count(*) DESC LIMIT 10 DEPRECATED Query that returns the top 10 most-queried schemas, in descending order. | (defmethod audit.i/internal-query ::most-queried
[_]
{:metadata [[:schema {:display_name "Schema", :base_type :type/Title}]
[:executions {:display_name "Executions", :base_type :type/Integer}]]
:results (common/reducible-query
{:with [[:counts {:select [[:db.name :db_name]
[:t.schema :db_schema]]
:from [[:query_execution :qe]]
:left-join [[:report_card :card] [:= :qe.card_id :card.id]
[:metabase_database :db] [:= :card.database_id :db.id]
[:metabase_table :t] [:= :card.table_id :t.id]]
:where [:and
[:not= :qe.card_id nil]
[:not= :card.database_id nil]
[:not= :card.table_id nil]
[:not= :db.id perms/audit-db-id]]}]]
:select [[(h2x/concat :db_name (h2x/literal " ") :db_schema) :schema]
[:%count.* :executions]]
:from [:counts]
:group-by [:db_name :db_schema]
:order-by [[:%count.* :desc]]
:limit 10})}) |
WITH counts AS ( SELECT db."name" AS dbname, t."schema" AS dbschema, qe.running_time FROM query_execution qe LEFT JOIN report_card card ON qe.card_id = card.id LEFT JOIN metabase_database db ON card.database_id = db.id LEFT JOIN metabase_table t ON card.table_id = t.id WHERE qe.card_id IS NOT NULL AND card.database_id IS NOT NULL AND card.table_id IS NOT NULL AND db.id != audit-db-id ) SELECT (dbname || ' ' || dbschema) AS "schema", avg(runningtime) AS avgrunning_time FROM counts GROUP BY dbname, dbschema ORDER BY avgrunningtime DESC LIMIT 10 DEPRECATED Query that returns the top 10 schemas with the slowest average query execution time in descending order. | (defmethod audit.i/internal-query ::slowest-schemas
[_]
{:metadata [[:schema {:display_name "Schema", :base_type :type/Title}]
[:avg_running_time {:display_name "Average Running Time (ms)", :base_type :type/Decimal}]]
:results (common/reducible-query
{:with [[:counts {:select [[:db.name :db_name]
[:t.schema :db_schema]
:qe.running_time]
:from [[:query_execution :qe]]
:left-join [[:report_card :card] [:= :qe.card_id :card.id]
[:metabase_database :db] [:= :card.database_id :db.id]
[:metabase_table :t] [:= :card.table_id :t.id]]
:where [:and
[:not= :qe.card_id nil]
[:not= :card.database_id nil]
[:not= :card.table_id nil]
[:not= :db.id perms/audit-db-id]]}]]
:select [[(h2x/concat :db_name (h2x/literal " ") :db_schema) :schema]
[[:avg :running_time] :avg_running_time]]
:from [:counts]
:group-by [:db_name :db_schema]
:order-by [[:avg_running_time :desc]]
:limit 10})}) |
WITH cards AS ( SELECT t.dbid AS databaseid, t."schema", count(*) AS saved_count FROM report_card c LEFT JOIN metabase_table t ON c.table_id = t.id WHERE c.table_id IS NOT NULL GROUP BY t.db_id, t."schema" ), schemas AS ( SELECT db.id AS databaseid, db.name AS databasename, t."schema", COUNT(*) AS tables FROM metabase_table t LEFT JOIN metabase_database db ON t.db_id = db.id WHERE db.id != audit-db-id GROUP BY db.id, t."schema" ORDER BY db.name ASC, t."schema" ASC ) SELECT s.databasename AS "database", s."schema", s.tables, c.savedcount AS saved_queries FROM schemas LEFT JOIN cards c ON s.databaseid = c.databaseid AND s."schema" = c."schema" DEPRECATED Query that returns a data for a table full of fascinating information about the different schemas in use in our application. | (mu/defmethod audit.i/internal-query ::table
([query-type]
(audit.i/internal-query query-type nil))
([_query-type query-string :- [:maybe :string]]
{:metadata [[:database_id {:display_name "Database ID", :base_type :type/Integer, :remapped_to :database}]
[:database {:display_name "Database", :base_type :type/Title, :remapped_from :database_id}]
[:schema_id {:display_name "Schema ID", :base_type :type/Text, :remapped_to :schema}]
[:schema {:display_name "Schema", :base_type :type/Title, :remapped_from :schema_id}]
[:tables {:display_name "Tables", :base_type :type/Integer}]
[:saved_queries {:display_name "Saved Queries", :base_type :type/Integer}]]
:results (common/reducible-query
(->
{:with [[:cards {:select [[:t.db_id :database_id]
:t.schema
[:%count.* :saved_count]]
:from [[:report_card :c]]
:left-join [[:metabase_table :t] [:= :c.table_id :t.id]]
:where [:not= :c.table_id nil]
:group-by [:t.db_id :t.schema]}]
[:schemas {:select [[:db.id :database_id]
[:db.name :database_name]
:t.schema
[:%count.* :tables]]
:from [[:metabase_table :t]]
:left-join [[:metabase_database :db] [:= :t.db_id :db.id]]
:where [:not= :db.id perms/audit-db-id]
:group-by [:db.id :t.schema]
:order-by [[:db.id :asc] [:t.schema :asc]]}]]
:select [:s.database_id
[:s.database_name :database]
[(h2x/concat :s.database_id (h2x/literal ".") :s.schema) :schema_id]
:s.schema
:s.tables
[:c.saved_count :saved_queries]]
:from [[:schemas :s]]
:left-join [[:cards :c] [:and
[:= :s.database_id :c.database_id]
[:= :s.schema :c.schema]]]}
(common/add-search-clause query-string :s.schema)))})) |
(ns metabase-enterprise.audit-app.pages.table-detail (:require [metabase-enterprise.audit-app.interface :as audit.i] [metabase-enterprise.audit-app.pages.common :as common] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [ring.util.codec :as codec])) | |
View log for a specific Table. | (mu/defmethod audit.i/internal-query ::audit-log
[_query-type table-id :- ms/PositiveInt]
{:metadata [[:started_at {:display_name "Viewed on", :base_type :type/DateTime}]
[:card_id {:display_name "Card ID", :base_type :type/Integer, :remapped_to :query}]
[:query {:display_name "Query", :base_type :type/Text, :remapped_from :card_id}]
[:query_hash {:display_name "Query Hash", :base_type :type/Text}]
[:user_id {:display_name "User ID", :base_type :type/Integer, :remapped_to :user}]
[:user {:display_name "Queried by", :base_type :type/Text, :remapped_from :user_id}]]
:results (common/reducible-query
{:select [:qe.started_at
[:card.id :card_id]
[(common/card-name-or-ad-hoc :card) :query]
[:qe.hash :query_hash]
[:u.id :user_id]
[(common/user-full-name :u) :user]]
:from [[:query_execution :qe]]
:where [:= :card.table_id table-id]
:join [[:core_user :u] [:= :qe.executor_id :u.id]
[:report_card :card] [:= :qe.card_id :card.id]]
:order-by [[:qe.started_at :desc]]})
:xform (map #(update (vec %) 3 codec/base64-encode))}) |
(ns metabase-enterprise.audit-app.pages.tables (:require [metabase-enterprise.audit-app.interface :as audit.i] [metabase-enterprise.audit-app.pages.common :as common] [metabase.models.permissions :as perms] [metabase.util.honey-sql-2 :as h2x] [metabase.util.malli :as mu])) | |
WITH table_executions AS ( SELECT t.id AS table_id, count(*) AS executions FROM query_execution qe JOIN reportcard card ON qe.cardid = card.id JOIN metabasetable t ON card.tableid = t.id WHERE t.db_id != audit-db-id GROUP BY t.id ORDER BY count(*) {{asc-or-desc}} LIMIT 10 ) SELECT tx.tableid, (db.name || ' ' || t.schema || ' ' t.name) AS tablename, tx.executions FROM table_executions tx JOIN metabasetable t ON tx.tableid = t.id JOIN metabasedatabase db ON t.dbid = db.id ORDER BY executions {{asc-or-desc}} | (defn- query-counts [asc-or-desc]
{:metadata [[:table_id {:display_name "Table ID", :base_type :type/Integer, :remapped_to :table_name}]
[:table_name {:display_name "Table", :base_type :type/Title, :remapped_from :table_id}]
[:executions {:display_name "Executions", :base_type :type/Integer}]]
:results (common/reducible-query
{:with [[:table_executions {:select [[:t.id :table_id]
[:%count.* :executions]]
:from [[:query_execution :qe]]
:join [[:report_card :card] [:= :qe.card_id :card.id]
[:metabase_table :t] [:= :card.table_id :t.id]]
:group-by [:t.id]
:order-by [[:%count.* asc-or-desc]]
:where [:not= :t.db_id perms/audit-db-id]
:limit 10}]]
:select [:tx.table_id
[(h2x/concat :db.name (h2x/literal " ") :t.schema (h2x/literal " ") :t.name) :table_name]
:tx.executions]
:from [[:table_executions :tx]]
:join [[:metabase_table :t] [:= :tx.table_id :t.id]
[:metabase_database :db] [:= :t.db_id :db.id]]
:order-by [[:executions asc-or-desc]]})}) |
Query that returns the top-10 most-queried Tables, in descending order. | (defmethod audit.i/internal-query ::most-queried [_] (query-counts :desc)) |
Query that returns the top-10 least-queried Tables (with at least one query execution), in ascending order. | (defmethod audit.i/internal-query ::least-queried [_] (query-counts :asc)) |
A table of Tables. | (mu/defmethod audit.i/internal-query ::table
([query-type]
(audit.i/internal-query query-type nil))
([_query-type query-string :- [:maybe :string]]
{:metadata [[:database_id {:display_name "Database ID", :base_type :type/Integer, :remapped_to :database_name}]
[:database_name {:display_name "Database", :base_type :type/Text, :remapped_from :database_id}]
[:schema_id {:display_name "Schema ID", :base_type :type/Text, :remapped_to :schema_name}]
[:table_schema {:display_name "Schema", :base_type :type/Text, :remapped_from :schema_id}]
[:table_id {:display_name "Table ID", :base_type :type/Integer, :remapped_to :table_name}]
[:table_name {:display_name "Table Name in DB", :base_type :type/Name, :remapped_from :table_id}]
[:table_display_name {:display_name "Table Display Name", :base_type :type/Text}]]
:results (common/reducible-query
(->
{:select [[:db.id :database_id]
[:db.name :database_name]
[(h2x/concat :db.id (h2x/literal ".") :t.schema) :schema_id]
[:t.schema :table_schema]
[:t.id :table_id]
[:t.name :table_name]
[:t.display_name :table_display_name]]
:from [[:metabase_table :t]]
:join [[:metabase_database :db] [:= :t.db_id :db.id]]
:order-by [[[:lower :db.name] :asc]
[[:lower :t.schema] :asc]
[[:lower :t.name] :asc]]
:where [:and
[:= :t.active true]
[:not= :t.db_id perms/audit-db-id]]}
(common/add-search-clause query-string :db.name :t.schema :t.name :t.display_name)))})) |
(ns metabase-enterprise.audit-app.pages.user-detail (:require [metabase-enterprise.audit-app.interface :as audit.i] [metabase-enterprise.audit-app.pages.common :as common] [metabase-enterprise.audit-app.pages.common.cards :as cards] [metabase-enterprise.audit-app.pages.common.dashboards :as dashboards] [metabase.util.honey-sql-2 :as h2x] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [metabase.util.urls :as urls] [ring.util.codec :as codec])) | |
Query that probides a single row of information about a given User, similar to the (TODO - in the designs, this is pivoted; should we do that here in Clojure-land?) | (mu/defmethod audit.i/internal-query ::table
[_query-type user-id :- ms/PositiveInt]
{:metadata [[:name {:display_name "Name", :base_type :type/Name}]
[:role {:display_name "Role", :base_type :type/Text}]
[:groups {:display_name "Groups", :base_type :type/Text}]
[:date_joined {:display_name "Date Joined", :base_type :type/DateTime}]
[:last_active {:display_name "Last Active", :base_type :type/DateTime}]
[:signup_method {:display_name "Signup Method", :base_type :type/Text}]
[:questions_saved {:display_name "Questions Saved", :base_type :type/Integer}]
[:dashboards_saved {:display_name "Dashboards Saved", :base_type :type/Integer}]
[:pulses_saved {:display_name "Pulses Saved", :base_type :type/Integer}]]
:results (common/reducible-query
{:with [[:last_query {:select [[:%max.started_at :started_at]]
:from [:query_execution]
:where [:= :executor_id user-id]}]
[:groups {:select [[(common/group-concat :pg.name ", ") :groups]]
:from [[:permissions_group_membership :pgm]]
:left-join [[:permissions_group :pg] [:= :pgm.group_id :pg.id]]
:where [:= :pgm.user_id user-id]}]
[:questions_saved {:select [[:%count.* :count]]
:from [:report_card]
:where [:= :creator_id user-id]}]
[:dashboards_saved {:select [[:%count.* :count]]
:from [:report_dashboard]
:where [:= :creator_id user-id]}]
[:pulses_saved {:select [[:%count.* :count]]
:from [:pulse]
:where [:= :creator_id user-id]}]
[:users {:select [[(common/user-full-name :u) :name]
[[:case
[:= :u.is_superuser true]
(h2x/literal "Admin")
:else
(h2x/literal "User")]
:role]
:id
:date_joined
[[:case
[:= nil :u.sso_source]
(h2x/literal "Email")
:else
:u.sso_source]
:signup_method]
:last_name]
:from [[:core_user :u]]
:where [:= :u.id user-id]}]]
:select [:u.name
:u.role
:groups.groups
:u.date_joined
[:last_query.started_at :last_active]
:u.signup_method
[:questions_saved.count :questions_saved]
[:dashboards_saved.count :dashboards_saved]
[:pulses_saved.count :pulses_saved]]
:from [[:users :u]
:groups
:last_query
:questions_saved
:dashboards_saved
:pulses_saved]})}) |
Return the 10 most-viewed Dashboards for a given User, in descending order. | (mu/defmethod audit.i/internal-query ::most-viewed-dashboards
[_query-type user-id :- ms/PositiveInt]
{:metadata [[:dashboard_id {:display_name "Dashboard ID", :base_type :type/Integer, :remapped_to :dashboard_name}]
[:dashboard_name {:display_name "Dashboard", :base_type :type/Name, :remapped_from :dashboard_id}]
[:count {:display_name "Views", :base_type :type/Integer}]]
:results (common/reducible-query
{:select [[:d.id :dashboard_id]
[:d.name :dashboard_name]
[:%count.* :count]]
:from [[:view_log :vl]]
:left-join [[:report_dashboard :d] [:= :vl.model_id :d.id]]
:where [:and
[:= :vl.user_id user-id]
[:= :vl.model (h2x/literal "dashboard")]]
:group-by [:d.id]
:order-by [[:%count.* :desc]]
:limit 10})}) |
Return the 10 most-viewed Questions for a given User, in descending order. | (mu/defmethod audit.i/internal-query ::most-viewed-questions
[_query-type user-id :- ms/PositiveInt]
{:metadata [[:card_id {:display_name "Card ID", :base_type :type/Integer, :remapped_to :card_name}]
[:card_name {:display_name "Query", :base_type :type/Name, :remapped_from :card_id}]
[:count {:display_name "Views", :base_type :type/Integer}]]
:results (common/reducible-query
{:select [[:d.id :card_id]
[:d.name :card_name]
[:%count.* :count]]
:from [[:view_log :vl]]
:left-join [[:report_card :d] [:= :vl.model_id :d.id]]
:where [:and
[:= :vl.user_id user-id]
[:= :vl.model (h2x/literal "card")]]
:group-by [:d.id]
:order-by [[:%count.* :desc]]
:limit 10})}) |
Query views by a specific User. | (mu/defmethod audit.i/internal-query ::query-views
[_query-type user-id :- ms/PositiveInt]
{:metadata [[:viewed_on {:display_name "Viewed On", :base_type :type/DateTime}]
[:card_id {:display_name "Card ID" :base_type :type/Integer, :remapped_to :card_name}]
[:card_name {:display_name "Query", :base_type :type/Text, :remapped_from :card_id}]
[:query_hash {:display_name "Query Hash", :base_type :type/Text}]
[:type {:display_name "Type", :base_type :type/Text}]
[:collection_id {:display_name "Collection ID", :base_type :type/Integer, :remapped_to :collection}]
[:collection {:display_name "Collection", :base_type :type/Text, :remapped_from :collection_id}]
[:saved_by_id {:display_name "Saving User ID", :base_type :type/Integer, :remapped_to :saved_by}]
[:saved_by {:display_name "Saved By", :base_type :type/Text, :remapped_from :saved_by_id}]
[:database_id {:display_name "Database ID", :base_type :type/Integer, :remapped_to :source_db}]
[:source_db {:display_name "Source DB", :base_type :type/Text, :remapped_from :database_id}]
[:table_id {:display_name "Table ID" :base_type :type/Integer, :remapped_to :table}]
[:table {:display_name "Table", :base_type :type/Text, :remapped_from :table_id}]]
:results (common/reducible-query
{:select [[:qe.started_at :viewed_on]
[:card.id :card_id]
[(common/card-name-or-ad-hoc :card) :card_name]
[:qe.hash :query_hash]
[(common/native-or-gui :qe) :type]
[:collection.id :collection_id]
[:collection.name :collection]
[:u.id :saved_by_id]
[(common/user-full-name :u) :saved_by]
[:db.id :database_id]
[:db.name :source_db]
[:t.id :table_id]
[:t.display_name :table]]
:from [[:query_execution :qe]]
:join [[:metabase_database :db] [:= :qe.database_id :db.id]]
:left-join [[:report_card :card] [:= :qe.card_id :card.id]
:collection [:= :card.collection_id :collection.id]
[:core_user :u] [:= :card.creator_id :u.id]
[:metabase_table :t] [:= :card.table_id :t.id]]
:where [:= :qe.executor_id user-id]
:order-by [[:qe.started_at :desc]]})
:xform (map #(update (vec %) 3 codec/base64-encode))}) |
Dashboard views by a specific User. | (mu/defmethod audit.i/internal-query ::dashboard-views
[_query-type user-id :- ms/PositiveInt]
{:metadata [[:timestamp {:display_name "Viewed on", :base_type :type/DateTime}]
[:dashboard_id {:display_name "Dashboard ID", :base_type :type/Integer, :remapped_to :dashboard_name}]
[:dashboard_name {:display_name "Dashboard", :base_type :type/Text, :remapped_from :dashboard_id}]
[:collection_id {:display_name "Collection ID", :base_type :type/Integer, :remapped_to :collection_name}]
[:collection_name {:display_name "Collection", :base_type :type/Text, :remapped_from :collection_id}]]
:results (common/reducible-query
{:select [:vl.timestamp
[:dash.id :dashboard_id]
[:dash.name :dashboard_name]
[:coll.id :collection_id]
[:coll.name :collection_name]]
:from [[:view_log :vl]]
:where [:and
[:= :vl.model (h2x/literal "dashboard")]
[:= :vl.user_id user-id]]
:join [[:report_dashboard :dash] [:= :vl.model_id :dash.id]]
:left-join [[:collection :coll] [:= :dash.collection_id :coll.id]]
:order-by [[:vl.timestamp :desc]]})}) |
Timeseries chart that shows the number of Question or Dashboard views for a User, broken out by | (mu/defmethod audit.i/internal-query ::object-views-by-time
[_query-type
user-id :- ms/PositiveInt
model :- [:enum "card" "dashboard"]
datetime-unit :- common/DateTimeUnitStr]
{:metadata [[:date {:display_name "Date", :base_type (common/datetime-unit-str->base-type datetime-unit)}]
[:views {:display_name "Views", :base_type :type/Integer}]]
:results (common/reducible-query
{:select [[(common/grouped-datetime datetime-unit :timestamp) :date]
[:%count.* :views]]
:from [:view_log]
:where [:and
[:= :user_id user-id]
[:= :model model]]
:group-by [(common/grouped-datetime datetime-unit :timestamp)]
:order-by [[(common/grouped-datetime datetime-unit :timestamp) :asc]]})}) |
Dashboards created by a specific User. | (mu/defmethod audit.i/internal-query ::created-dashboards ([query-type user-id] (audit.i/internal-query query-type user-id nil)) ([_query-type user-id :- ms/PositiveInt query-string :- [:maybe :string]] (dashboards/table query-string [:= :u.id user-id]))) |
Questions created by a specific User. | (mu/defmethod audit.i/internal-query ::created-questions
[_query-type user-id :- ms/PositiveInt]
{:metadata [[:card_id {:display_name "Card ID", :base_type :type/Integer, :remapped_to :card_name}]
[:card_name {:display_name "Title", :base_type :type/Name, :remapped_from :card_id}]
[:collection_id {:display_name "Collection ID", :base_type :type/Integer, :remapped_to :collection_name}]
[:collection_name {:display_name "Collection", :base_type :type/Text, :remapped_from :collection_id}]
[:created_at {:display_name "Created At", :base_type :type/DateTime}]
[:database_id {:display_name "Database ID", :base_type :type/Integer, :remapped_to :database_name}]
[:database_name {:display_name "Database", :base_type :type/Text, :remapped_from :database_id}]
[:table_id {:display_name "Table ID", :base_type :type/Integer, :remapped_to :table_name}]
[:table_name {:display_name "Table", :base_type :type/Text, :remapped_from :table_id}]
[:avg_running_time_ms {:display_name "Avg. exec. time (ms)", :base_type :type/Number}]
[:cache_ttl {:display_name "Cache Duration", :base_type :type/Number}]
[:public_link {:display_name "Public Link", :base_type :type/URL}]
[:total_views {:display_name "Total Views", :base_type :type/Integer}]]
:results (common/reducible-query
{:with [cards/avg-exec-time
cards/views]
:select [[:card.id :card_id]
[:card.name :card_name]
[:coll.id :collection_id]
[:coll.name :collection_name]
:card.created_at
:card.database_id
[:db.name :database_name]
:card.table_id
[:t.name :table_name]
:avg_exec_time.avg_running_time_ms
:card.cache_ttl
[[:case
[:not= :card.public_uuid nil]
(h2x/concat (urls/public-card-prefix) :card.public_uuid)]
:public_link]
[:card_views.count :total_views]]
:from [[:report_card :card]]
:left-join [:avg_exec_time [:= :card.id :avg_exec_time.card_id]
[:metabase_database :db] [:= :card.database_id :db.id]
[:metabase_table :t] [:= :card.table_id :t.id]
[:collection :coll] [:= :card.collection_id :coll.id]
:card_views [:= :card.id :card_views.card_id]]
:where [:= :card.creator_id user-id]
:order-by [[[:lower :card.name] :asc]]})}) |
Table of query downloads (i.e., queries whose results are returned as CSV/JSON/XLS) done by this user, ordered by most recent. | (mu/defmethod audit.i/internal-query ::downloads
[_query-type user-id :- ms/PositiveInt]
{:metadata [[:downloaded_at {:display_name "Downloaded At", :base_type :type/DateTime}]
[:rows_downloaded {:display_name "Rows Downloaded", :base_type :type/Integer}]
[:card_id {:display_name "Card ID", :base_type :type/Integer, :remapped_to :card_name}]
[:card_name {:display_name "Query", :base_type :type/Text, :remapped_from :card_id}]
[:query_type {:display_name "Query Type", :base_type :type/Text}]
[:database_id {:display_name "Database ID", :base_type :type/Integer, :remapped_to :database}]
[:database {:display_name "Database", :base_type :type/Text, :remapped_from :database_id}]
[:table_id {:display_name "Table ID", :base_type :type/Integer, :remapped_to :source_table}]
[:source_table {:display_name "Source Table", :base_type :type/Text, :remapped_from :table_id}]]
:results (common/reducible-query
{:select [[:qe.started_at :downloaded_at]
[:qe.result_rows :rows_downloaded]
[:card.id :card_id]
[(common/card-name-or-ad-hoc :card) :card_name]
[(common/native-or-gui :qe) :query_type]
[:db.id :database_id]
[:db.name :database]
[:t.id :table_id]
[:t.name :source_table]]
:from [[:query_execution :qe]]
:left-join [[:report_card :card] [:= :card.id :qe.card_id]
[:metabase_database :db] [:= :qe.database_id :db.id]
[:metabase_table :t] [:= :card.table_id :t.id]]
:where [:and
[:= :executor_id user-id]
(common/query-execution-is-download :qe)]
:order-by [[:qe.started_at :desc]]})}) |
(ns metabase-enterprise.audit-app.pages.users (:require [metabase-enterprise.audit-app.interface :as audit.i] [metabase-enterprise.audit-app.pages.common :as common] [metabase.util.honey-sql-2 :as h2x] [metabase.util.malli :as mu] [ring.util.codec :as codec])) | |
DEPRECATED Query that returns data for a two-series timeseries: the number of DAU (a User is considered active for purposes of this query if they ran at least one query that day), and total number of queries ran. Broken out by day. | (defmethod audit.i/internal-query ::active-users-and-queries-by-day
[_]
{:metadata [[:users {:display_name "Users", :base_type :type/Integer}]
[:queries {:display_name "Queries", :base_type :type/Integer}]
[:day {:display_name "Date", :base_type :type/Date}]]
:results (common/reducible-query
{:with [[:user_qe {:select [:executor_id
[:%count.* :executions]
[(h2x/cast :date :started_at) :day]]
:from [:query_execution]
:group-by [:executor_id :day]}]]
:select [[:%count.* :users]
[:%sum.executions :queries]
:day]
:from [:user_qe]
:group-by [:day]
:order-by [[:day :asc]]})}) |
Two-series timeseries that returns number of active Users (Users who ran at least one query) and number of new
Users, broken out by | (mu/defmethod audit.i/internal-query ::active-and-new-by-time
[_query-type datetime-unit :- common/DateTimeUnitStr]
{:metadata [[:date {:display_name "Date", :base_type (common/datetime-unit-str->base-type datetime-unit)}]
[:active_users {:display_name "Active Users", :base_type :type/Integer}]
[:new_users {:display_name "New Users", :base_type :type/Integer}]]
;; this is so nice and easy to implement in a single query with FULL OUTER JOINS but unfortunately only pg supports
;; them(!)
:results (let [active (common/query
{:select [[(common/grouped-datetime datetime-unit :started_at) :date]
[[::h2x/distinct-count :executor_id] :count]]
:from [:query_execution]
:group-by [(common/grouped-datetime datetime-unit :started_at)]})
date->active (zipmap (map :date active) (map :count active))
new (common/query
{:select [[(common/grouped-datetime datetime-unit :date_joined) :date]
[:%count.* :count]]
:from [:core_user]
:group-by [(common/grouped-datetime datetime-unit :date_joined)]})
date->new (zipmap (map :date new) (map :count new))
all-dates (sort (keep identity (distinct (concat (keys date->active)
(keys date->new)))))]
(for [date all-dates]
{:date date
:active_users (date->active date 0)
:new_users (date->new date 0)}))}) |
Query that returns the 10 most active Users (by number of query executions) in descending order. | (defmethod audit.i/internal-query ::most-active
[_]
{:metadata [[:user_id {:display_name "User ID", :base_type :type/Integer, :remapped_to :name}]
[:name {:display_name "Member", :base_type :type/Name, :remapped_from :user_id}]
[:count {:display_name "Query Executions", :base_type :type/Integer}]]
:results (common/reducible-query
{:with [[:qe_count {:select [[:%count.* :count]
:qe.executor_id]
:from [[:query_execution :qe]]
:where [:not= nil :qe.executor_id]
:group-by [:qe.executor_id]
:order-by [[:%count.* :desc]]
:limit 10}]]
:select [[:u.id :user_id]
[(common/user-full-name :u) :name]
[(common/zero-if-null :qe_count.count) :count]]
:from [[:core_user :u]]
:left-join [:qe_count [:= :qe_count.executor_id :u.id]]
:order-by [[:count :desc]
[[:lower :u.last_name] :asc]
[[:lower :u.first_name] :asc]
[[:lower :u.email] :asc]]
:limit 10})}) |
Query that returns the 10 Users with the most saved objects in descending order. | (defmethod audit.i/internal-query ::most-saves
[_]
{:metadata [[:user_id {:display_name "User ID", :base_type :type/Integer, :remapped_to :user_name}]
[:user_name {:display_name "Member", :base_type :type/Name, :remapped_from :user_id}]
[:saves {:display_name "Saved Objects", :base_type :type/Integer}]]
:results (common/reducible-query
{:with [[:card_saves {:select [:creator_id
[:%count.* :count]]
:from [:report_card]
:group-by [:creator_id]}]
[:dashboard_saves {:select [:creator_id
[:%count.* :count]]
:from [:report_dashboard]
:group-by [:creator_id]}]
[:pulse_saves {:select [:creator_id
[:%count.* :count]]
:from [:pulse]
:group-by [:creator_id]}]]
:select [[:u.id :user_id]
[(common/user-full-name :u) :user_name]
[(h2x/+ (common/zero-if-null :card_saves.count)
(common/zero-if-null :dashboard_saves.count)
(common/zero-if-null :pulse_saves.count))
:saves]]
:from [[:core_user :u]]
:left-join [:card_saves [:= :u.id :card_saves.creator_id]
:dashboard_saves [:= :u.id :dashboard_saves.creator_id]
:pulse_saves [:= :u.id :pulse_saves.creator_id]]
:order-by [[:saves :desc]
[:u.last_name :asc]
[:u.first_name :asc]
[:u.email :asc]]
:limit 10})}) |
Query that returns the total time spent executing queries, broken out by User, for the top 10 Users. | (defmethod audit.i/internal-query ::query-execution-time-per-user
[_]
{:metadata [[:user_id {:display_name "User ID", :base_type :type/Integer, :remapped_to :name}]
[:name {:display_name "Member", :base_type :type/Name, :remapped_from :user_id}]
[:execution_time_ms {:display_name "Total Execution Time (ms)", :base_type :type/Decimal}]]
:results (common/reducible-query
{:with [[:exec_time {:select [[:%sum.running_time :execution_time_ms]
:qe.executor_id]
:from [[:query_execution :qe]]
:where [:not= nil :qe.executor_id]
:group-by [:qe.executor_id]
:order-by [[:%sum.running_time :desc]]
:limit 10}]]
:select [[:u.id :user_id]
[(common/user-full-name :u) :name]
[[:case [:not= :exec_time.execution_time_ms nil] :exec_time.execution_time_ms
:else 0]
:execution_time_ms]]
:from [[:core_user :u]]
:left-join [:exec_time [:= :exec_time.executor_id :u.id]]
:order-by [[:execution_time_ms :desc]
[[:lower :u.last_name] :asc]
[[:lower :u.first_name] :asc]
[[:lower :u.email] :asc]]
:limit 10})}) |
A table of all the Users for this instance, and various statistics about them (see metadata below). | (mu/defmethod audit.i/internal-query ::table
([query-type]
(audit.i/internal-query query-type nil))
([_query-type query-string :- [:maybe :string]]
{:metadata [[:user_id {:display_name "User ID", :base_type :type/Integer, :remapped_to :name}]
[:name {:display_name "Member", :base_type :type/Name, :remapped_from :user_id}]
[:role {:display_name "Role", :base_type :type/Text}]
[:groups {:display_name "Groups", :base_type :type/Text}]
[:date_joined {:display_name "Date Joined", :base_type :type/DateTime}]
[:last_active {:display_name "Last Active", :base_type :type/DateTime}]
[:signup_method {:display_name "Signup Method", :base_type :type/Text}]
[:questions_saved {:display_name "Questions Saved", :base_type :type/Integer}]
[:dashboards_saved {:display_name "Dashboards Saved", :base_type :type/Integer}]
[:pulses_saved {:display_name "Pulses Saved", :base_type :type/Integer}]]
:results (common/reducible-query
(->
{:with [[:last_query {:select [[:executor_id :id]
[:%max.started_at :started_at]]
:from [:query_execution]
:group-by [:executor_id]}]
[:groups {:select [[:u.id :id]
[(common/group-concat :pg.name ", ") :groups]]
:from [[:core_user :u]]
:left-join [[:permissions_group_membership :pgm] [:= :u.id :pgm.user_id]
[:permissions_group :pg] [:= :pgm.group_id :pg.id]]
:group-by [:u.id]}]
[:questions_saved {:select [[:u.id :id]
[:%count.* :count]]
:from [[:report_card :c]]
:left-join [[:core_user :u] [:= :u.id :c.creator_id]]
:group-by [:u.id]}]
[:dashboards_saved {:select [[:u.id :id]
[:%count.* :count]]
:from [[:report_dashboard :d]]
:left-join [[:core_user :u] [:= :u.id :d.creator_id]]
:group-by [:u.id]}]
[:pulses_saved {:select [[:u.id :id]
[:%count.* :count]]
:from [[:pulse :p]]
:left-join [[:core_user :u] [:= :u.id :p.creator_id]]
:group-by [:u.id]}]
[:users {:select [[(common/user-full-name :u) :name]
[[:case
[:= :u.is_superuser true]
(h2x/literal "Admin")
:else
(h2x/literal "User")]
:role]
:id
:date_joined
[[:case
[:= "google" :u.sso_source]
(h2x/literal "Google Sign-In")
[:= "saml" :u.sso_source]
(h2x/literal "SAML")
[:= "jwt" :u.sso_source]
(h2x/literal "JWT")
[:= "ldap" :u.sso_source]
(h2x/literal "LDAP")
[:= nil :u.sso_source]
(h2x/literal "Email")
:else
:u.sso_source]
:signup_method]
:last_name
:first_name]
:from [[:core_user :u]]}]]
:select [[:u.id :user_id]
:u.name
:u.role
:groups.groups
:u.date_joined
[:last_query.started_at :last_active]
:u.signup_method
[:questions_saved.count :questions_saved]
[:dashboards_saved.count :dashboards_saved]
[:pulses_saved.count :pulses_saved]]
:from [[:users :u]]
:left-join [:groups [:= :u.id :groups.id]
:last_query [:= :u.id :last_query.id]
:questions_saved [:= :u.id :questions_saved.id]
:dashboards_saved [:= :u.id :dashboards_saved.id]
:pulses_saved [:= :u.id :pulses_saved.id]]
:order-by [[[:lower :u.last_name] :asc]
[[:lower :u.first_name] :asc]]}
(common/add-search-clause query-string :u.first_name :u.last_name)))})) |
Return a log of all query executions, including information about the Card associated with the query and the Collection it is in (both, if applicable) and Database/Table referenced by the query. | (defmethod audit.i/internal-query ::query-views
[_]
{:metadata [[:viewed_on {:display_name "Viewed On", :base_type :type/DateTime}]
[:card_id {:display_name "Card ID" :base_type :type/Integer, :remapped_to :card_name}]
[:card_name {:display_name "Query", :base_type :type/Text, :remapped_from :card_id}]
[:query_hash {:display_name "Query Hash", :base_type :type/Text}]
[:type {:display_name "Type", :base_type :type/Text}]
[:collection_id {:display_name "Collection ID", :base_type :type/Integer, :remapped_to :collection}]
[:collection {:display_name "Collection", :base_type :type/Text, :remapped_from :collection_id}]
[:viewed_by_id {:display_name "Viewing User ID", :base_type :type/Integer, :remapped_to :viewed_by}]
[:viewed_by {:display_name "Viewed By", :base_type :type/Text, :remapped_from :viewed_by_id}]
[:saved_by_id {:display_name "Saving User ID", :base_type :type/Integer, :remapped_to :saved_by}]
[:saved_by {:display_name "Saved By", :base_type :type/Text, :remapped_from :saved_by_id}]
[:database_id {:display_name "Database ID", :base_type :type/Integer, :remapped_to :source_db}]
[:source_db {:display_name "Source DB", :base_type :type/Text, :remapped_from :database_id}]
[:table_id {:display_name "Table ID" :base_type :type/Integer, :remapped_to :table}]
[:table {:display_name "Table", :base_type :type/Text, :remapped_from :table_id}]]
:results (common/reducible-query
{:select [[:qe.started_at :viewed_on]
[:card.id :card_id]
[(common/card-name-or-ad-hoc :card) :card_name]
[:qe.hash :query_hash]
[(common/native-or-gui :qe) :type]
[:collection.id :collection_id]
[:collection.name :collection]
[:viewer.id :viewed_by_id]
[(common/user-full-name :viewer) :viewed_by]
[:creator.id :saved_by_id]
[(common/user-full-name :creator) :saved_by]
[:db.id :database_id]
[:db.name :source_db]
[:t.id :table_id]
[:t.display_name :table]]
:from [[:query_execution :qe]]
:join [[:metabase_database :db] [:= :qe.database_id :db.id]
[:core_user :viewer] [:= :qe.executor_id :viewer.id]]
:left-join [[:report_card :card] [:= :qe.card_id :card.id]
:collection [:= :card.collection_id :collection.id]
[:core_user :creator] [:= :card.creator_id :creator.id]
[:metabase_table :t] [:= :card.table_id :t.id]]
:order-by [[:qe.started_at :desc]]})
:xform (map #(update (vec %) 3 codec/base64-encode))}) |
Return a log of when all Dashboard views, including the Collection the Dashboard belongs to. | (defmethod audit.i/internal-query ::dashboard-views
[_]
{:metadata [[:timestamp {:display_name "Viewed on", :base_type :type/DateTime}]
[:dashboard_id {:display_name "Dashboard ID", :base_type :type/Integer, :remapped_to :dashboard_name}]
[:dashboard_name {:display_name "Dashboard", :base_type :type/Text, :remapped_from :dashboard_id}]
[:collection_id {:display_name "Collection ID", :base_type :type/Integer, :remapped_to :collection_name}]
[:collection_name {:display_name "Collection", :base_type :type/Text, :remapped_from :collection_id}]
[:user_id {:display_name "User ID", :base_type :type/Integer, :remapped_to :user_name}]
[:user_name {:display_name "Viewed By", :base_type :type/Text, :remapped_from :user_id}]]
:results (common/reducible-query
{:select [:vl.timestamp
[:dash.id :dashboard_id]
[:dash.name :dashboard_name]
[:coll.id :collection_id]
[:coll.name :collection_name]
[:u.id :user_id]
[(common/user-full-name :u) :user_name]]
:from [[:view_log :vl]]
:where [:= :vl.model (h2x/literal "dashboard")]
:join [[:report_dashboard :dash] [:= :vl.model_id :dash.id]
[:core_user :u] [:= :vl.user_id :u.id]]
:left-join [[:collection :coll] [:= :dash.collection_id :coll.id]]
:order-by [[:vl.timestamp :desc]]})}) |
(ns metabase-enterprise.audit-app.permissions (:require [metabase-enterprise.audit-db :refer [default-audit-collection]] [metabase.lib.metadata :as lib.metadata] [metabase.models.interface :as mi] [metabase.models.permissions :as perms] [metabase.models.query.permissions :as query-perms] [metabase.public-settings.premium-features :refer [defenterprise]] [metabase.query-processor.store :as qp.store] [metabase.shared.util.i18n :refer [tru]] [metabase.util :as u] [toucan2.core :as t2])) | |
Used for giving granular permissions into the audit db. Instead of granting permissions to all of the audit db, we query the audit db using the names of each view that starts with v_. | (def audit-db-view-names
#{"v_audit_log"
"v_content"
"v_dashboardcard"
"v_group_members"
"v_subscriptions"
"v_users"
"v_alerts"
"v_databases"
"v_fields"
"v_query_log"
"v_tables"
"v_tasks"
"v_view_log"}) |
Performs a number of permission checks to ensure that a query on the Audit database can be run. Causes for rejection are: - if the current user does not have access to the analytics collection - native queries - queries that include tables that are not audit views | (defenterprise check-audit-db-permissions
:feature :audit-app
[{query-type :type, database-id :database, query :query :as outer-query}]
;; Check if the user has access to the analytics collection, since this should be coupled with access to the
;; audit database in general.
(when-not (mi/can-read? (default-audit-collection))
(throw (ex-info (tru "You do not have access to the audit database") outer-query)))
;; query->source-table-ids returns a set of table IDs and/or the ::query-perms/native keyword
(when (= query-type :native)
(throw (ex-info (tru "Native queries are not allowed on the audit database")
outer-query)))
(let [table-ids-or-native-kw (query-perms/query->source-table-ids query)]
(qp.store/with-metadata-provider database-id
(doseq [table-id table-ids-or-native-kw]
(when (= table-id ::query-perms/native)
(throw (ex-info (tru "Native queries are not allowed on the audit database")
outer-query)))
(when-not (audit-db-view-names
(u/lower-case-en (:name (lib.metadata/table (qp.store/metadata-provider) table-id))))
(throw (ex-info (tru "Audit queries are only allowed on audit views")
outer-query))))))) |
Will remove or grant audit db (AppDB) permissions, if the instance analytics collection permissions changes. This technically isn't necessary, because we block all audit DB queries if a user doesn't have collection permissions. But it's cleaner to keep the audit DB permission paths in the database consistent. | (defenterprise update-audit-collection-permissions!
:feature :audit-app
[group-id changes]
(let [[change-id type] (first (filter #(= (first %) (:id (default-audit-collection))) changes))]
(when change-id
(let [change-permissions! (case type
:read perms/grant-permissions!
:none perms/delete-related-permissions!
:write (throw (ex-info (tru (str "Unable to make audit collections writable."))
{:status-code 400})))
view-tables (t2/select :model/Table :db_id perms/audit-db-id :name [:in audit-db-view-names])]
(doseq [table view-tables]
(change-permissions! group-id (perms/table-query-path table))))))) |
Middleware that handles special {:type :internal :fn "metabase-enterprise.audit-app.pages.dashboards/table" :args []} ; optional vector of args to pass to the fn above To run an (defmethod audit.i/internal-query ::table [_] {:metadata ..., :results ...}) The function should return a map with two keys, LEGACY FORMAT:
REDUCIBLE FORMAT:
| (ns metabase-enterprise.audit-app.query-processor.middleware.handle-audit-queries
(:require
[clojure.data :as data]
[metabase-enterprise.audit-app.interface :as audit.i]
[metabase.api.common.validation :as validation]
[metabase.public-settings.premium-features
:as premium-features
:refer [defenterprise]]
[metabase.query-processor.context :as qp.context]
[metabase.query-processor.error-type :as qp.error-type]
[metabase.util.i18n :refer [tru]]
[metabase.util.malli :as mu])) |
Primarily for dev and debugging purposes. We can probably take this out when shipping the finished product. | (defn- check-results-and-metadata-keys-match
[results metadata]
(let [results-keys (set (keys (first results)))
metadata-keys (set (map (comp keyword first) metadata))]
(when (and (seq results-keys)
(not= results-keys metadata-keys))
(let [[only-in-results only-in-metadata] (data/diff results-keys metadata-keys)]
(throw
(Exception.
(str "results-keys and metadata-keys differ.\n"
"results-keys: " results-keys "\n"
"metadata-keys: " metadata-keys "\n"
"in results, but not metadata: " only-in-results "\n"
"in metadata, but not results: " only-in-metadata))))))) |
(defn- metadata->cols [metadata]
(for [[k v] metadata]
(assoc v :name (name k)))) | |
(mu/defn ^:private format-results [{:keys [results metadata]} :- [:map
[:results [:sequential :map]]
[:metadata audit.i/ResultsMetadata]]]
(check-results-and-metadata-keys-match results metadata)
{:cols (metadata->cols metadata)
:rows (for [row results]
(for [[k] metadata]
(get row (keyword k))))}) | |
Schema for a valid | (def InternalQuery
[:map
[:type [:enum :internal "internal"]]
[:fn [:and
:string
[:fn
{:error/message "namespace-qualified symbol serialized as a string"}
(fn [s]
(try
(when-let [symb (symbol s)]
(qualified-symbol? symb))
(catch Throwable _)))]]]
[:args {:optional true} [:sequential :any]]]) |
Additional | (def ^:dynamic *additional-query-params* nil) |
(defn- reduce-reducible-results [rff context {:keys [metadata results xform], :or {xform identity}}]
(let [cols (metadata->cols metadata)
reducible-rows (results context)
rff* (fn [metadata]
(xform (rff metadata)))]
(assert (some? cols))
(assert (instance? clojure.lang.IReduceInit reducible-rows))
(qp.context/reducef rff* context {:cols cols} reducible-rows))) | |
(defn- reduce-legacy-results [rff context results]
(let [{:keys [cols rows]} (format-results results)]
(assert (some? cols))
(assert (some? rows))
(qp.context/reducef rff context {:cols cols} rows))) | |
(defn- reduce-results [rff context {rows :results, :as results}]
((if (fn? rows)
reduce-reducible-results
reduce-legacy-results) rff context results)) | |
(mu/defn ^:private process-internal-query
[{qualified-fn-str :fn, args :args, :as query} :- InternalQuery rff context]
;; Make sure current user is a superuser or has monitoring permissions
(validation/check-has-application-permission :monitoring)
;; Make sure audit app is enabled (currently the only use case for internal queries). We can figure out a way to
;; allow non-audit-app queries if and when we add some
(when-not (premium-features/enable-audit-app?)
(throw (ex-info (tru "Audit App queries are not enabled on this instance.")
{:type qp.error-type/invalid-query})))
(binding [*additional-query-params* (dissoc query :fn :args)]
(let [resolved (apply audit.i/resolve-internal-query qualified-fn-str args)]
(reduce-results rff context resolved)))) | |
Middleware that handles | (defenterprise handle-audit-app-internal-queries
:feature :audit-app
[qp]
(fn [{query-type :type, :as query} rff context]
(if (= :internal (keyword query-type))
(process-internal-query query rff context)
(qp query rff context)))) |
(ns metabase-enterprise.audit-db (:require [babashka.fs :as fs] [clojure.java.io :as io] [clojure.string :as str] [metabase-enterprise.internal-user :as ee.internal-user] [metabase-enterprise.serialization.cmd :as serialization.cmd] [metabase.db.connection :as mdb.connection] [metabase.db.env :as mdb.env] [metabase.models.database :refer [Database]] [metabase.models.permissions :as perms] [metabase.models.setting :refer [defsetting]] [metabase.plugins :as plugins] [metabase.public-settings.premium-features :refer [defenterprise]] [metabase.sync.util :as sync-util] [metabase.util :as u] [metabase.util.files :as u.files] [metabase.util.log :as log] [toucan2.core :as t2]) (:import (java.util.jar JarEntry JarFile))) | |
(set! *warn-on-reflection* true) | |
Returns true iff we are running from a jar. .getResource will return a java.net.URL, and those start with "jar:" if and only if the app is running from a jar. More info: https://docs.oracle.com/en/java/javase/11/docs/api/java.base/java/lang/Thread.html | (defn- running-from-jar?
[]
(-> (Thread/currentThread)
(.getContextClassLoader)
(.getResource "")
(str/starts-with? "jar:"))) |
Returns the path to the currently running jar file. More info: https://stackoverflow.com/questions/320542/how-to-get-the-path-of-a-running-jar-file | (defn- get-jar-path
[]
(assert (running-from-jar?) "Can only get-jar-path when running from a jar.")
(-> (class {})
(.getProtectionDomain)
(.getCodeSource)
(.getLocation)
(.toURI) ;; avoid problems with special characters in path.
(.getPath))) |
Recursively copies a subdirectory (at resource-path) from the jar at jar-path into out-dir. Scans every file in resources, to see which ones are inside of resource-path, since there's no way to "ls" or list a directory inside of a jar's resources. | (defn copy-from-jar!
[jar-path resource-path out-dir]
(let [jar-file (JarFile. (str jar-path))
entries (.entries jar-file)]
(doseq [^JarEntry entry (iterator-seq entries)
:let [entry-name (.getName entry)]
:when (str/starts-with? entry-name resource-path)
:let [out-file (fs/path out-dir entry-name)]]
(if (.isDirectory entry)
(fs/create-dirs out-file)
(do
(-> out-file fs/parent fs/create-dirs)
(with-open [in (.getInputStream jar-file entry)
out (io/output-stream (str out-file))]
(io/copy in out))))))) |
Default audit collection entity (instance analytics) id. | (def ^:private default-audit-collection-entity-id "vG58R8k-QddHWA7_47umn") |
Default custom reports entity id. | (def ^:private default-custom-reports-entity-id "okNLSZKdSxaoG58JSQY54") |
Returns the collection from entity id for collections. Memoizes from entity id. | (defn collection-entity-id->collection
[entity-id]
((mdb.connection/memoize-for-application-db
(fn [entity-id]
(t2/select-one :model/Collection :entity_id entity-id))) entity-id)) |
Default custom reports collection. | (defenterprise default-custom-reports-collection :feature :none [] (collection-entity-id->collection default-custom-reports-entity-id)) |
Default audit collection (instance analytics) collection. | (defenterprise default-audit-collection :feature :none [] (collection-entity-id->collection default-audit-collection-entity-id)) |
Creates the audit db, a clone of the app db used for auditing purposes.
| (defn- install-database!
[engine id]
(t2/insert! Database {:is_audit true
:id id
:name "Internal Metabase Database"
:description "Internal Audit DB used to power metabase analytics."
:engine engine
:is_full_sync true
:is_on_demand false
:creator_id nil
:auto_run_queries true})
;; guard against someone manually deleting the audit-db entry, but not removing the audit-db permissions.
(t2/delete! :model/Permissions {:where [:like :object (str "%/db/" id "/%")]})) |
(defn- adjust-audit-db-to-source!
[{audit-db-id :id}]
;; We need to move back to a schema that matches the serialized data
(when (contains? #{:mysql :h2} mdb.env/db-type)
(t2/update! :model/Database audit-db-id {:engine "postgres"})
(when (= :mysql mdb.env/db-type)
(t2/update! :model/Table {:db_id audit-db-id} {:schema "public"}))
(when (= :h2 mdb.env/db-type)
(t2/update! :model/Table {:db_id audit-db-id} {:schema [:lower :schema] :name [:lower :name]})
(t2/update! :model/Field
{:table_id
[:in
{:select [:id]
:from [(t2/table-name :model/Table)]
:where [:= :db_id audit-db-id]}]}
{:name [:lower :name]}))
(log/infof "Adjusted Audit DB for loading Analytics Content"))) | |
(defn- adjust-audit-db-to-host!
[{audit-db-id :id :keys [engine]}]
(when (not= engine mdb.env/db-type)
;; We need to move the loaded data back to the host db
(t2/update! :model/Database audit-db-id {:engine (name mdb.env/db-type)})
(when (= :mysql mdb.env/db-type)
(t2/update! :model/Table {:db_id audit-db-id} {:schema nil}))
(when (= :h2 mdb.env/db-type)
(t2/update! :model/Table {:db_id audit-db-id} {:schema [:upper :schema] :name [:upper :name]})
(t2/update! :model/Field
{:table_id
[:in
{:select [:id]
:from [(t2/table-name :model/Table)]
:where [:= :db_id audit-db-id]}]}
{:name [:upper :name]}))
(log/infof "Adjusted Audit DB to match host engine: %s" (name mdb.env/db-type)))) | |
A resource dir containing analytics content created by Metabase to load into the app instance on startup. | (def ^:private analytics-dir-resource (io/resource "instance_analytics")) |
The directory analytics content is unzipped or moved to, and subsequently loaded into the app from on startup. | (defn- instance-analytics-plugin-dir [plugins-dir] (fs/path (fs/absolutize plugins-dir) "instance_analytics")) |
Load instance analytics content (collections/dashboards/cards/etc.) from resources dir or a zip file and copies it into the provided directory (by default, plugins/instance_analytics). | (defn- ia-content->plugins
[plugins-dir]
(let [ia-dir (instance-analytics-plugin-dir plugins-dir)]
(when (fs/exists? (u.files/relative-path ia-dir))
(fs/delete-tree (u.files/relative-path ia-dir)))
(if (running-from-jar?)
(let [path-to-jar (get-jar-path)]
(log/info "The app is running from a jar, starting copy...")
(copy-from-jar! path-to-jar "instance_analytics/" plugins-dir)
(log/info "Copying complete."))
(let [in-path (fs/path analytics-dir-resource)]
(log/info "The app is not running from a jar, starting copy...")
(log/info (str "Copying " in-path " -> " ia-dir))
(fs/copy-tree (u.files/relative-path in-path)
(u.files/relative-path ia-dir)
{:replace-existing true})
(log/info "Copying complete."))))) |
Whether or not we should load Metabase analytics content on startup. Defaults to true, but can be disabled via environment variable. | (defsetting load-analytics-content :type :boolean :default true :visibility :internal :setter :none :audit :never :doc false) |
(defn- maybe-load-analytics-content!
[audit-db]
(when (and analytics-dir-resource (load-analytics-content))
(ee.internal-user/ensure-internal-user-exists!)
(adjust-audit-db-to-source! audit-db)
(log/info "Loading Analytics Content...")
(ia-content->plugins (plugins/plugins-dir))
(log/info (str "Loading Analytics Content from: " (instance-analytics-plugin-dir (plugins/plugins-dir))))
;; The EE token might not have :serialization enabled, but audit features should still be able to use it.
(let [report (log/with-no-logs
(serialization.cmd/v2-load-internal! (str (instance-analytics-plugin-dir (plugins/plugins-dir)))
{:backfill? false}
:token-check? false))]
(if (not-empty (:errors report))
(log/info (str "Error Loading Analytics Content: " (pr-str report)))
(log/info (str "Loading Analytics Content Complete (" (count (:seen report)) ") entities loaded."))))
(when-let [audit-db (t2/select-one :model/Database :is_audit true)]
(adjust-audit-db-to-host! audit-db)))) | |
(defn- maybe-install-audit-db
[]
(let [audit-db (t2/select-one :model/Database :is_audit true)]
(cond
(nil? audit-db)
(u/prog1 ::installed
(log/info "Installing Audit DB...")
(install-database! mdb.env/db-type perms/audit-db-id))
(not= mdb.env/db-type (:engine audit-db))
(u/prog1 ::updated
(log/infof "App DB change detected. Changing Audit DB source to match: %s." (name mdb.env/db-type))
(adjust-audit-db-to-host! audit-db))
:else
::no-op))) | |
EE implementation of | (defenterprise ensure-audit-db-installed!
:feature :none
[]
(u/prog1 (maybe-install-audit-db)
(let [audit-db (t2/select-one :model/Database :is_audit true)]
;; prevent sync while loading
((sync-util/with-duplicate-ops-prevented :sync-database audit-db
(fn [] (maybe-load-analytics-content! audit-db))))))) |
(ns metabase-enterprise.content-verification.api.review (:require [compojure.core :refer [POST]] [metabase.api.common :as api] [metabase.models.moderation-review :as moderation-review] [metabase.moderation :as moderation] [metabase.util.malli.schema :as ms])) | |
/ | (api/defendpoint POST
"Create a new `ModerationReview`."
[:as {{:keys [text moderated_item_id moderated_item_type status]} :body}]
{text [:maybe :string]
moderated_item_id ms/PositiveInt
moderated_item_type moderation/moderated-item-types
status [:maybe moderation-review/Statuses]}
(api/check-superuser)
(let [review-data {:text text
:moderated_item_id moderated_item_id
:moderated_item_type moderated_item_type
:moderator_id api/*current-user-id*
:status status}]
(api/check-404 (moderation/moderated-item review-data))
(moderation-review/create-review! review-data))) |
(api/define-routes) | |
(ns metabase-enterprise.content-verification.api.routes (:require [compojure.core :as compojure :refer [context]] [metabase-enterprise.api.routes.common :as ee.api.common] [metabase-enterprise.content-verification.api.review :as review] [metabase.api.routes.common :refer [+auth]] [metabase.util.i18n :refer [deferred-tru]])) | |
(defn- +require-content-verification [handler] (ee.api.common/+require-premium-feature :content-verification (deferred-tru "Content verification") handler)) | |
API routes only available if we have a premium token with the | (compojure/defroutes routes (context "/moderation-review" [] (+require-content-verification (+auth review/routes)))) |
Unless otherwise noted, all files © 2024 Metabase, Inc. Source code in this repository is variously licensed under the GNU Affero General Public License (AGPL), or the Metabase Commercial License. | |
Empty namespace. This is here solely so we can try to require it and see whether or not EE code is on the classpath. | (ns metabase-enterprise.core) |
(ns metabase-enterprise.dashboard-subscription-filters.pulse (:require [metabase.public-settings.premium-features :refer [defenterprise]])) | |
Enterprise way of getting dashboard filter parameters. Blends parameters from dashboard subscription and the dashboard itself. | (defenterprise the-parameters
:feature :dashboard-subscription-filters
[pulse dashboard]
(let [pulse-params (:parameters pulse)
dashboard-params (:parameters dashboard)
pulse-params-by-id (group-by :id pulse-params)
dashboard-params-by-id (group-by :id dashboard-params)
ids (distinct (map :id (concat pulse-params dashboard-params)))]
(for [id ids]
(merge (first (get dashboard-params-by-id id))
(first (get pulse-params-by-id id)))))) |
(ns metabase-enterprise.enhancements.integrations.google (:require [metabase.integrations.google.interface :as google.i] [metabase.models.setting :as setting] [metabase.models.setting.multi-setting :refer [define-multi-setting-impl]])) | |
(define-multi-setting-impl google.i/google-auth-auto-create-accounts-domain :ee :getter (fn [] (setting/get-value-of-type :string :google-auth-auto-create-accounts-domain)) :setter (fn [domain] (setting/set-value-of-type! :string :google-auth-auto-create-accounts-domain domain))) | |
The Enterprise version of the LDAP integration is basically the same but also supports syncing user attributes. | (ns metabase-enterprise.enhancements.integrations.ldap
(:require
[metabase-enterprise.sso.integrations.sso-utils :as sso-utils]
[metabase.integrations.common :as integrations.common]
[metabase.integrations.ldap.default-implementation :as default-impl]
[metabase.models.setting :as setting :refer [defsetting]]
[metabase.models.user :as user :refer [User]]
[metabase.public-settings.premium-features
:as premium-features
:refer [defenterprise-schema]]
[metabase.util :as u]
[metabase.util.i18n :refer [deferred-tru]]
[metabase.util.malli.schema :as ms]
[toucan2.core :as t2])
(:import
(com.unboundid.ldap.sdk LDAPConnectionPool))) |
(def ^:private EEUserInfo [:merge default-impl/UserInfo [:map [:attributes [:maybe [:map-of :keyword :any]]]]]) | |
(defsetting ldap-sync-user-attributes (deferred-tru "Should we sync user attributes when someone logs in via LDAP?") :type :boolean :default true :audit :getter) | |
TODO - maybe we want to add a csv setting type? | (defsetting ldap-sync-user-attributes-blacklist (deferred-tru "Comma-separated list of user attributes to skip syncing for LDAP users.") :default "userPassword,dn,distinguishedName" :type :csv :audit :getter) |
(defsetting ldap-group-membership-filter
(deferred-tru "Group membership lookup filter. The placeholders '{dn}' and '{uid}' will be replaced by the user''s Distinguished Name and UID, respectively.")
:default "(member={dn})"
:audit :getter) | |
(defn- syncable-user-attributes [m]
(when (ldap-sync-user-attributes)
(apply dissoc m :objectclass (map (comp keyword u/lower-case-en) (ldap-sync-user-attributes-blacklist))))) | |
(defn- attribute-synced-user
[{:keys [attributes first-name last-name email]}]
(when-let [user (t2/select-one [User :id :last_login :first_name :last_name :login_attributes :is_active]
:%lower.email (u/lower-case-en email))]
(let [syncable-attributes (syncable-user-attributes attributes)
old-first-name (:first_name user)
old-last-name (:last_name user)
user-changes (merge
(when-not (= syncable-attributes (:login_attributes user))
{:login_attributes syncable-attributes})
(when (not= first-name old-first-name)
{:first_name first-name})
(when (not= last-name old-last-name)
{:last_name last-name}))]
(if (seq user-changes)
(do
(t2/update! User (:id user) user-changes)
(t2/select-one [User :id :last_login :is_active] :id (:id user))) ; Reload updated user
user)))) | |
(defenterprise-schema find-user :- [:maybe EEUserInfo]
"Get user information for the supplied username."
:feature :sso-ldap
[ldap-connection :- (ms/InstanceOfClass LDAPConnectionPool)
username :- ms/NonBlankString
settings :- default-impl/LDAPSettings]
(when-let [result (default-impl/search ldap-connection username settings)]
(when-let [user-info (default-impl/ldap-search-result->user-info
ldap-connection
result
settings
(ldap-group-membership-filter))]
(assoc user-info :attributes (syncable-user-attributes result))))) | |
for some reason the | #_{:clj-kondo/ignore [:deprecated-var]}
(defenterprise-schema fetch-or-create-user! :- (ms/InstanceOf User)
"Using the `user-info` (from `find-user`) get the corresponding Metabase user, creating it if necessary."
:feature :sso-ldap
[{:keys [first-name last-name email groups attributes], :as user-info} :- EEUserInfo
{:keys [sync-groups?], :as settings} :- default-impl/LDAPSettings]
(let [user (or (attribute-synced-user user-info)
(sso-utils/check-user-provisioning :ldap)
(-> (user/create-new-ldap-auth-user! {:first_name first-name
:last_name last-name
:email email
:login_attributes attributes})
(assoc :is_active true)))]
(u/prog1 user
(when sync-groups?
(let [group-ids (default-impl/ldap-groups->mb-group-ids groups settings)
all-mapped-group-ids (default-impl/all-mapped-group-ids settings)]
(integrations.common/sync-group-memberships! user
group-ids
all-mapped-group-ids)))))) |
(ns metabase-enterprise.internal-user
(:require [metabase.config :as config]
[metabase.models :refer [User]]
[metabase.util.log :as log]
[toucan2.core :as t2])) | |
(defn- install-internal-user! []
(t2/insert-returning-instances!
User
{:id config/internal-mb-user-id
:first_name "Metabase"
:last_name "Internal"
:email "internal@metabase.com"
:password (str (random-uuid))
:is_active false
:is_superuser false
:login_attributes nil
:sso_source nil
:type :internal})) | |
Creates the internal user | (defn ensure-internal-user-exists!
[]
(if-not (t2/exists? User :id config/internal-mb-user-id)
(do (log/info "No internal user found, creating now...")
(install-internal-user!)
::installed)
::no-op)) |
(ns metabase-enterprise.models (:require [metabase.plugins.classloader :as classloader] [metabase.public-settings.premium-features :as premium-features :refer [defenterprise]] [metabase.util :as u])) | |
Tries to require a given model in each of the possible enterprise model namespaces, to ensure it is required. | (defenterprise resolve-enterprise-model
:feature :none
[x]
(when (and (keyword? x)
(= (namespace x) "model")
;; Don't try to require if it's already registered as a :metabase/model, since that means it has already
;; been required
(not (isa? x :metabase/model)))
(doseq [feature @premium-features/premium-features]
(u/ignore-exceptions
(let [model-namespace (symbol (str "metabase-enterprise." (name feature) ".models." (u/->kebab-case-en (name x))))]
;; use `classloader/require` which is thread-safe and plays nice with our plugins system
(classloader/require model-namespace)))))
x) |
| (ns metabase-enterprise.sandbox.api.gtap (:require [compojure.core :refer [DELETE GET POST PUT]] [metabase-enterprise.sandbox.models.group-table-access-policy :as gtap :refer [GroupTableAccessPolicy]] [metabase.api.common :as api] [metabase.public-settings.premium-features :as premium-features] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
/ | (api/defendpoint GET
"Fetch a list of all GTAPs currently in use, or a single GTAP if both `group_id` and `table_id` are provided."
[group_id table_id]
{group_id [:maybe ms/PositiveInt]
table_id [:maybe ms/PositiveInt]}
(if (and group_id table_id)
(t2/select-one GroupTableAccessPolicy :group_id group_id :table_id table_id)
(t2/select GroupTableAccessPolicy {:order-by [[:id :asc]]}))) |
/:id | (api/defendpoint GET
"Fetch GTAP by `id`"
[id]
{id ms/PositiveInt}
(api/check-404 (t2/select-one GroupTableAccessPolicy :id id))) |
TODO - not sure what other endpoints we might need, e.g. for fetching the list above but for a given group or Table | |
/ | #_(def ^:private AttributeRemappings
(mu/with-api-error-message [:maybe [:map-of ms/NonBlankString ms/NonBlankString]]
"value must be a valid attribute remappings map (attribute name -> remapped name)"))
(api/defendpoint POST
"Create a new GTAP."
[:as {{:keys [table_id card_id group_id attribute_remappings]} :body}]
{table_id ms/PositiveInt
card_id [:maybe ms/PositiveInt]
group_id ms/PositiveInt
#_attribute_remappings #_AttributeRemappings} ; TODO - fix me
(first (t2/insert-returning-instances! GroupTableAccessPolicy
{:table_id table_id
:card_id card_id
:group_id group_id
:attribute_remappings attribute_remappings}))) |
/:id | (api/defendpoint PUT
"Update a GTAP entry. The only things you're allowed to update for a GTAP are the Card being used (`card_id`) or the
paramter mappings; changing `table_id` or `group_id` would effectively be deleting this entry and creating a new
one. If that's what you want to do, do so explicity with appropriate calls to the `DELETE` and `POST` endpoints."
[id :as {{:keys [card_id #_attribute_remappings], :as body} :body}]
{id ms/PositiveInt
card_id [:maybe ms/PositiveInt]
#_attribute_remappings #_AttributeRemappings} ; TODO - fix me
(api/check-404 (t2/select-one GroupTableAccessPolicy :id id))
;; Only update `card_id` and/or `attribute_remappings` if the values are present in the body of the request.
;; This allows existing values to be "cleared" by being set to nil
(when (some #(contains? body %) [:card_id :attribute_remappings])
(t2/update! GroupTableAccessPolicy id
(u/select-keys-when body
:present #{:card_id :attribute_remappings})))
(t2/select-one GroupTableAccessPolicy :id id)) |
/validate | (api/defendpoint POST
"Validate a sandbox which may not have yet been saved. This runs the same validation that is performed when the
sandbox is saved, but doesn't actually save the sandbox."
[:as {{:keys [table_id card_id]} :body}]
{table_id ms/PositiveInt
card_id [:maybe ms/PositiveInt]}
(gtap/check-columns-match-table {:table_id table_id
:card_id card_id})) |
/:id | (api/defendpoint DELETE
"Delete a GTAP entry."
[id]
{id ms/PositiveInt}
(api/check-404 (t2/select-one GroupTableAccessPolicy :id id))
(t2/delete! GroupTableAccessPolicy :id id)
api/generic-204-no-content) |
Wrap the Ring handler to make sure sandboxes are enabled before allowing access to the API endpoints. | (defn- +check-sandboxes-enabled
[handler]
(fn [request respond raise]
(if-not (premium-features/enable-sandboxes?)
(raise (ex-info (str (tru "Error: sandboxing is not enabled for this instance.")
" "
(tru "Please check you have set a valid Enterprise token and try again."))
{:status-code 403}))
(handler request respond raise)))) |
All endpoints in this namespace require superuser perms to view TODO - does it make sense to have this middleware
here? Or should we just wrap TODO - defining the | (api/define-routes api/+check-superuser +check-sandboxes-enabled) |
API routes that are only enabled if we have a premium token with the | (ns metabase-enterprise.sandbox.api.routes (:require [compojure.core :as compojure] [metabase-enterprise.api.routes.common :as ee.api.common] [metabase-enterprise.sandbox.api.gtap :as gtap] [metabase-enterprise.sandbox.api.table :as table] [metabase-enterprise.sandbox.api.user :as user] [metabase.api.routes.common :refer [+auth]] [metabase.util.i18n :refer [deferred-tru]])) |
Ring routes for mt API endpoints. | (compojure/defroutes routes
;; EE-only sandboxing routes live under `/mt` for historical reasons. `/mt` is for multi-tenant.
;;
;; TODO - We should change this to `/sandboxes` or something like that.
(compojure/context
"/mt" []
(ee.api.common/+require-premium-feature
:sandboxes
(deferred-tru "Sandboxes")
(compojure/routes
(compojure/context "/gtap" [] (+auth gtap/routes))
(compojure/context "/user" [] (+auth user/routes)))))
;; when sandboxing is enabled we *replace* GET /api/table/:id/query_metadata with a special EE version. If
;; sandboxing is not enabled, this passes thru to the OSS implementation of the endpoint.
#_{:clj-kondo/ignore [:deprecated-var]}
(compojure/context "/table" [] (ee.api.common/+when-premium-feature :sandboxes (+auth table/routes)))) |
(ns metabase-enterprise.sandbox.api.table (:require [clojure.set :as set] [compojure.core :refer [GET]] [metabase.api.common :as api] [metabase.api.table :as api.table] [metabase.mbql.util :as mbql.u] [metabase.models.card :refer [Card]] [metabase.models.interface :as mi] [metabase.models.permissions :as perms] [metabase.models.table :as table :refer [Table]] [metabase.util :as u] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) | |
(mu/defn ^:private find-gtap-question :- [:maybe (mi/InstanceOf Card)]
"Find the associated GTAP question (if there is one) for the given `table-or-table-id` and
`user-or-user-id`. Returns nil if no question was found."
[table-or-table-id user-or-user-id]
(t2/select-one Card
{:select [:c.id :c.dataset_query]
:from [[:sandboxes]]
:join [[:permissions_group_membership :pgm] [:= :sandboxes.group_id :pgm.group_id]
[:report_card :c] [:= :c.id :sandboxes.card_id]]
:where [:and
[:= :sandboxes.table_id (u/the-id table-or-table-id)]
[:= :pgm.user_id (u/the-id user-or-user-id)]]})) | |
(mu/defn only-sandboxed-perms? :- :boolean
"Returns true if the user has only segemented and not full table permissions. If the user has full table permissions
we wouldn't want to apply this segment filtering."
[table :- (mi/InstanceOf Table)]
(and
(not (perms/set-has-full-permissions? @api/*current-user-permissions-set*
(perms/table-query-path table)))
(perms/set-has-full-permissions? @api/*current-user-permissions-set*
(perms/table-sandboxed-query-path table)))) | |
(mu/defn ^:private query->fields-ids :- [:maybe [:sequential :int]]
[{{{:keys [fields]} :query} :dataset_query} :- [:maybe :map]]
(mbql.u/match fields [:field (id :guard integer?) _] id)) | |
(defn- maybe-filter-fields [table query-metadata-response]
;; If we have sandboxed permissions and the associated GTAP limits the fields returned, we need make sure the
;; query_metadata endpoint also excludes any fields the GTAP query would exclude
(if-let [gtap-field-ids (and (only-sandboxed-perms? table)
(seq (query->fields-ids (find-gtap-question table api/*current-user-id*))))]
(update query-metadata-response :fields #(filter (comp (set gtap-field-ids) u/the-id) %))
query-metadata-response)) | |
/:id/query_metadata | (api/defendpoint GET
"This endpoint essentially acts as a wrapper for the OSS version of this route. When a user has sandboxed permissions
that only gives them access to a subset of columns for a given table, those inaccessable columns should also be
excluded from what is show in the query builder. When the user has full permissions (or no permissions) this route
doesn't add/change anything from the OSS version. See the docs on the OSS version of the endpoint for more
information."
[id include_sensitive_fields include_hidden_fields include_editable_data_model]
{id ms/PositiveInt
include_sensitive_fields [:maybe ms/BooleanValue]
include_hidden_fields [:maybe ms/BooleanValue]
include_editable_data_model [:maybe ms/BooleanValue]}
(let [table (api/check-404 (t2/select-one Table :id id))
sandboxed-perms? (only-sandboxed-perms? table)
thunk (fn []
(maybe-filter-fields
table
(api.table/fetch-query-metadata
table
{:include-sensitive-fields? include_sensitive_fields
:include-hidden-fields? include_hidden_fields
:include-editable-data-model? include_editable_data_model})))]
;; if the user has sandboxed perms, temporarily upgrade their perms to read perms for the Table so they can see the
;; metadata
(if sandboxed-perms?
(binding [api/*current-user-permissions-set* (atom
(set/union
@api/*current-user-permissions-set*
(mi/perms-objects-set table :read)))]
(thunk))
(thunk)))) |
(api/define-routes) | |
Endpoint(s)for setting user attributes. | (ns metabase-enterprise.sandbox.api.user (:require [clojure.set :as set] [compojure.core :refer [GET PUT]] [metabase.api.common :as api] [metabase.models.user :refer [User]] [metabase.util.i18n :refer [deferred-tru]] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2])) |
(def ^:private UserAttributes
(mu/with-api-error-message
[:map-of
:keyword
:any]
(deferred-tru "value must be a valid user attributes map (name -> value)"))) | |
/:id/attributes TODO - not sure we need this endpoint now that we're just letting you edit from the regular `PUT /api/user/:id endpoint | (api/defendpoint PUT
"Update the `login_attributes` for a User."
[id :as {{:keys [login_attributes]} :body}]
{id ms/PositiveInt
login_attributes [:maybe UserAttributes]}
(api/check-404 (t2/select-one User :id id))
(pos? (t2/update! User id {:login_attributes login_attributes}))) |
/attributes | (api/defendpoint GET
"Fetch a list of possible keys for User `login_attributes`. This just looks at keys that have already been set for
existing Users and returns those. "
[]
(->>
;; look at the `login_attributes` for the first 1000 users that have them set. Then make a set of the keys
(for [login-attributes (t2/select-fn-set :login_attributes User :login_attributes [:not= nil] {:limit 1000})
:when (seq login-attributes)]
(set (keys login-attributes)))
;; combine all the sets of attribute keys into a single set
(reduce set/union #{}))) |
(api/define-routes api/+check-superuser) | |
Enterprise specific API utility functions | (ns metabase-enterprise.sandbox.api.util
(:require
[clojure.set :as set]
[metabase-enterprise.sandbox.models.group-table-access-policy
:refer [GroupTableAccessPolicy]]
[metabase.api.common :refer [*current-user-id* *is-superuser?*]]
[metabase.models.permissions :as perms :refer [Permissions]]
[metabase.models.permissions-group-membership
:refer [PermissionsGroupMembership]]
[metabase.public-settings.premium-features :refer [defenterprise]]
[metabase.util.i18n :refer [tru]]
[toucan2.core :as t2])) |
Takes the permission set for each group a user is in, and a sandbox, and determines whether the sandbox should be enforced for the current user. This is done by checking whether the union of permissions in all other groups provides full data access to the sandboxed table. If so, we don't enforce the sandbox, because the other groups' permissions supercede it. | (defn- enforce-sandbox?
[group-id->perms-set {group-id :group_id, table-id :table_id}]
(let [perms-set (->> (dissoc group-id->perms-set group-id)
(vals)
(apply set/union))]
(not (perms/set-has-full-permissions? perms-set (perms/table-query-path table-id))))) |
Given a list of sandboxes and a list of permission group IDs that the current user is in, filter the sandboxes to only include ones that should be enforced for the current user. A sandbox is not enforced if the user is in a different permissions group that grants full access to the table. | (defn enforced-sandboxes
[sandboxes group-ids]
(let [perms (when (seq group-ids)
(t2/select Permissions {:where [:in :group_id group-ids]}))
group-id->perms-set (-> (group-by :group_id perms)
(update-vals (fn [perms] (into #{} (map :object) perms))))]
(filter (partial enforce-sandbox? group-id->perms-set)
sandboxes))) |
Returns true if the currently logged in user has segmented permissions. Throws an exception if no current user is bound. | (defenterprise sandboxed-user?
:feature :sandboxes
[]
(boolean
(when-not *is-superuser?*
(if *current-user-id*
(let [group-ids (t2/select-fn-set :group_id PermissionsGroupMembership :user_id *current-user-id*)
sandboxes (when (seq group-ids)
(t2/select GroupTableAccessPolicy :group_id [:in group-ids]))]
(seq (enforced-sandboxes sandboxes group-ids)))
;; If no *current-user-id* is bound we can't check for sandboxes, so we should throw in this case to avoid
;; returning `false` for users who should actually be sandboxes.
(throw (ex-info (str (tru "No current user found"))
{:status-code 403})))))) |
Model definition for Group Table Access Policy, aka GTAP. A GTAP is useed to control access to a certain Table for a certain PermissionsGroup. Whenever a member of that group attempts to query the Table in question, a Saved Question specified by the GTAP is instead used as the source of the query. See documentation in [[metabase.models.permissions]] for more information about the Metabase permissions system. | (ns metabase-enterprise.sandbox.models.group-table-access-policy (:require [medley.core :as m] [metabase.mbql.normalize :as mbql.normalize] [metabase.models.card :refer [Card]] [metabase.models.interface :as mi] [metabase.models.permissions :as perms :refer [Permissions]] [metabase.models.table :as table] [metabase.plugins.classloader :as classloader] [metabase.public-settings.premium-features :refer [defenterprise]] [metabase.query-processor.error-type :as qp.error-type] [metabase.server.middleware.session :as mw.session] [metabase.util :as u] [metabase.util.i18n :refer [tru]] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [methodical.core :as methodical] [toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase. | (def GroupTableAccessPolicy :model/GroupTableAccessPolicy) |
(methodical/defmethod t2/table-name :model/GroupTableAccessPolicy [_model] :sandboxes) | |
(doto :model/GroupTableAccessPolicy (derive :metabase/model) ;;; only admins can work with GTAPs (derive ::mi/read-policy.superuser) (derive ::mi/write-policy.superuser)) | |
(defn- normalize-attribute-remapping-targets [attribute-remappings] (m/map-vals mbql.normalize/normalize attribute-remappings)) | |
(t2/deftransforms :model/GroupTableAccessPolicy
{:attribute_remappings {:in (comp mi/json-in normalize-attribute-remapping-targets)
:out (comp normalize-attribute-remapping-targets mi/json-out-without-keywordization)}}) | |
Return a mapping of field names to corresponding cols for given table. | (defn table-field-names->cols
[table-id]
(classloader/require 'metabase.query-processor)
(into {} (for [col (mw.session/with-current-user nil
((resolve 'metabase.query-processor/query->expected-cols)
{:database (table/table-id->database-id table-id)
:type :query
:query {:source-table table-id}}))]
[(:name col) col]))) |
Assert that the base type of | (defn check-column-types-match
{:arglists '([col table-col])}
[col {table-col-base-type :base_type}]
;; These errors might get triggered by API endpoints or by the QP (this code is used in the
;; `row-level-restrictions` middleware). So include `:type` and `:status-code` information in the ExceptionInfo
;; data so it can be passed along if applicable.
(when table-col-base-type
(when-not (isa? (keyword (:base_type col)) table-col-base-type)
(let [msg (tru "Sandbox Questions can''t return columns that have different types than the Table they are sandboxing.")]
(throw (ex-info msg
{:type qp.error-type/bad-configuration
:status-code 400
:message msg
:new-col col
:expected table-col-base-type
:actual (:base_type col)})))))) |
Make sure the result metadata data columns for the Card associated with a GTAP match up with the columns in the Table that's getting GTAPped. It's ok to remove columns, but you cannot add new columns. The base types of the Card columns can derive from the respective base types of the columns in the Table itself, but you cannot return an entirely different type. | (mu/defn check-columns-match-table
([{card-id :card_id, table-id :table_id}]
;; not all GTAPs have Cards
(when card-id
;; not all Cards have saved result metadata
(when-let [result-metadata (t2/select-one-fn :result_metadata Card :id card-id)]
(check-columns-match-table table-id result-metadata))))
([table-id :- ms/PositiveInt result-metadata-columns]
;; prevent circular refs
(classloader/require 'metabase.query-processor)
(let [table-cols (table-field-names->cols table-id)]
(doseq [col result-metadata-columns
:let [table-col (get table-cols (:name col))]]
(check-column-types-match col table-col))))) |
If a Card is updated, and its result metadata changes, check that these changes do not violate the constraints placed on GTAPs (the Card cannot add fields or change types vs. the original Table). | (defenterprise pre-update-check-sandbox-constraints
:feature :sandboxes
[{new-result-metadata :result_metadata, card-id :id}]
(when new-result-metadata
(when-let [gtaps-using-this-card (not-empty (t2/select [GroupTableAccessPolicy :id :table_id] :card_id card-id))]
(let [original-result-metadata (t2/select-one-fn :result_metadata Card :id card-id)]
(when-not (= original-result-metadata new-result-metadata)
(doseq [{table-id :table_id} gtaps-using-this-card]
(try
(check-columns-match-table table-id new-result-metadata)
(catch clojure.lang.ExceptionInfo e
(throw (ex-info (str (tru "Cannot update Card: Card is used for Sandboxing, and updates would violate sandbox rules.")
" "
(.getMessage e))
(ex-data e)
e)))))))))) |
Create new | (defenterprise upsert-sandboxes!
:feature :sandboxes
[sandboxes]
(for [sandbox sandboxes]
(if-let [id (:id sandbox)]
;; Only update `card_id` and/or `attribute_remappings` if the values are present in the body of the request.
;; This allows existing values to be "cleared" by being set to nil
(do
(when (some #(contains? sandbox %) [:card_id :attribute_remappings])
(t2/update! GroupTableAccessPolicy
id
(u/select-keys-when sandbox :present #{:card_id :attribute_remappings})))
(t2/select-one GroupTableAccessPolicy :id id))
(let [expected-permission-path (perms/table-sandboxed-query-path (:table_id sandbox))]
(when-let [permission-path-id (t2/select-one-fn :id Permissions :object expected-permission-path)]
(first (t2/insert-returning-instances! GroupTableAccessPolicy (assoc sandbox :permission_id permission-path-id)))))))) |
(t2/define-before-insert :model/GroupTableAccessPolicy
[gtap]
(u/prog1 gtap
(check-columns-match-table gtap))) | |
(t2/define-before-update :model/GroupTableAccessPolicy
[{:keys [id], :as updates}]
(u/prog1 updates
(let [original (t2/original updates)
updated (merge original updates)]
(when-not (= (:table_id original) (:table_id updated))
(throw (ex-info (tru "You cannot change the Table ID of a GTAP once it has been created.")
{:id id
:status-code 400})))
(when (:card_id updates)
(check-columns-match-table updated))))) | |
(ns metabase-enterprise.sandbox.models.params.field-values
(:require
[metabase-enterprise.advanced-permissions.api.util
:as advanced-perms.api.u]
[metabase-enterprise.sandbox.api.table :as table]
[metabase-enterprise.sandbox.models.group-table-access-policy
:refer [GroupTableAccessPolicy]]
[metabase-enterprise.sandbox.query-processor.middleware.row-level-restrictions
:as row-level-restrictions]
[metabase.api.common :as api]
[metabase.mbql.util :as mbql.u]
[metabase.models :refer [Field PermissionsGroupMembership]]
[metabase.models.field :as field]
[metabase.models.field-values :as field-values]
[metabase.models.params.field-values :as params.field-values]
[metabase.public-settings.premium-features :refer [defenterprise]]
[metabase.util :as u]
[toucan2.core :as t2])) | |
(comment api/keep-me) | |
Check if a field is sandboxed. | (defn field-is-sandboxed?
[{:keys [table], :as field}]
;; slight optimization: for the `field-id->field-values` version we can batched hydrate `:table` to avoid having to
;; make a bunch of calls to fetch Table. For `get-or-create-field-values` we don't hydrate `:table` so we can fall
;; back to fetching it manually with `field/table`
(table/only-sandboxed-perms? (or table (field/table field)))) |
Find the GTAP for current user that apply to table | (defn- table-id->gtap
[table-id]
(let [group-ids (t2/select-fn-set :group_id PermissionsGroupMembership :user_id api/*current-user-id*)
gtaps (t2/select GroupTableAccessPolicy
:group_id [:in group-ids]
:table_id table-id)]
(when gtaps
(row-level-restrictions/assert-one-gtap-per-table gtaps)
;; there shold be only one gtap per table and we only need one table here
;; see docs in [[metabase.models.permissions]] for more info
(t2/hydrate (first gtaps) :card)))) |
Returns the gtap attributes for current user that applied to The gtap-attributes is a list with 2 elements:
1. card-id - for GTAP that use a saved question
2. the timestamp when the saved question was last updated
3. a map:
if query is mbql query:
- with key is the user-attribute that applied to the table that For example we have an GTAP rules {:card_id 1 ;; a mbql query :attribute_remappings {"State" [:dimension [:field 3 nil]]}} And users with login-attributes {"State" "CA"} ;; (field-id->gtap-attributes-for-current-user (t2/select-one Field :id 3)) ;; -> [1, {"State" "CA"}] | (defn- field->gtap-attributes-for-current-user
[{:keys [table_id] :as _field}]
(when-let [gtap (table-id->gtap table_id)]
(let [login-attributes (:login_attributes @api/*current-user*)
attribute_remappings (:attribute_remappings gtap)
field-ids (t2/select-fn-set :id Field :table_id table_id)]
[(:card_id gtap)
(-> gtap :card :updated_at)
(if (= :native (get-in gtap [:card :query_type]))
;; For sandbox that uses native query, we can't narrow down to the exact attribute
;; that affect the current table. So we just hash the whole login-attributes of users.
;; This makes hashing a bit less efficient but it ensures that user get a new hash
;; if they change login attributes
login-attributes
(into {} (for [[k v] attribute_remappings
;; get attribute that map to fields of the same table
:when (contains? field-ids
(mbql.u/match-one v [:dimension [:field field-id _]] field-id))]
{k (get login-attributes k)})))]))) |
Fetch existing FieldValues for a sequence of | (defenterprise field-id->field-values-for-current-user
:feature :sandboxes
[field-ids]
(let [fields (when (seq field-ids)
(t2/hydrate (t2/select Field :id [:in (set field-ids)]) :table))
{unsandboxed-fields false
sandboxed-fields true} (group-by (comp boolean field-is-sandboxed?) fields)]
(merge
;; use the normal OSS batched implementation for any Fields that aren't subject to sandboxing.
(when (seq unsandboxed-fields)
(params.field-values/default-field-id->field-values-for-current-user
(map u/the-id unsandboxed-fields)))
;; for sandboxed fields, fetch the sandboxed values individually.
(into {} (for [{field-id :id, :as field} sandboxed-fields]
[field-id (select-keys (params.field-values/get-or-create-advanced-field-values! :sandbox field)
[:values :human_readable_values :field_id])]))))) |
Fetch cached FieldValues for a | (defenterprise get-or-create-field-values-for-current-user!*
:feature :sandboxes
[field]
(cond
(field-is-sandboxed? field)
(params.field-values/get-or-create-advanced-field-values! :sandbox field)
;; Impersonation can have row-level security enforced by the database, so we still need to store field values per-user.
;; TODO: only do this for DBs with impersonation in effect
(and api/*current-user-id*
(advanced-perms.api.u/impersonated-user?))
(params.field-values/get-or-create-advanced-field-values! :impersonation field)
:else
(params.field-values/default-get-or-create-field-values-for-current-user! field))) |
Returns a hash-key for linked-filter FieldValues if the field is sandboxed, otherwise fallback to the OSS impl. | (defenterprise hash-key-for-linked-filters
:feature :sandboxes
[field-id constraints]
(let [field (t2/select-one Field :id field-id)]
(if (field-is-sandboxed? field)
(str (hash (concat [field-id
constraints]
(field->gtap-attributes-for-current-user field))))
(field-values/default-hash-key-for-linked-filters field-id constraints)))) |
Returns a hash-key for FieldValues if the field is sandboxed, otherwise fallback to the OSS impl. | (defenterprise hash-key-for-sandbox
:feature :sandboxes
[field-id]
(let [field (t2/select-one Field :id field-id)]
(when (field-is-sandboxed? field)
(str (hash (concat [field-id]
(field->gtap-attributes-for-current-user field))))))) |
(ns metabase-enterprise.sandbox.models.permissions.delete-sandboxes
(:require
[metabase-enterprise.sandbox.models.group-table-access-policy
:refer [GroupTableAccessPolicy]]
[metabase.db.query :as mdb.query]
[metabase.public-settings.premium-features :refer [defenterprise]]
[metabase.util :as u]
[metabase.util.i18n :refer [tru]]
[metabase.util.log :as log]
[toucan2.core :as t2])) | |
(defn- delete-gtaps-with-condition! [group-or-id condition]
(when (seq condition)
(let [conditions (into
[:and
[:= :sandboxes.group_id (u/the-id group-or-id)]]
[condition])]
(log/debugf "Deleting GTAPs for Group %d with conditions %s" (u/the-id group-or-id) (pr-str conditions))
(try
(if-let [gtap-ids (not-empty (set (map :id (mdb.query/query
{:select [[:sandboxes.id :id]]
:from [[:sandboxes]]
:left-join [[:metabase_table :table]
[:= :sandboxes.table_id :table.id]]
:where conditions}))))]
(do
(log/debugf "Deleting %d matching GTAPs: %s" (count gtap-ids) (pr-str gtap-ids))
(t2/delete! GroupTableAccessPolicy :id [:in gtap-ids]))
(log/debug "No matching GTAPs need to be deleted."))
(catch Throwable e
(throw (ex-info (tru "Error deleting Sandboxes: {0}" (ex-message e))
{:group (u/the-id group-or-id), :conditions conditions}
e))))))) | |
(defn- delete-gtaps-for-group-table! [{:keys [group-id table-id] :as _context} changes]
(log/debugf "Deleting unneeded GTAPs for Group %d for Table %d. Graph changes: %s"
group-id table-id (pr-str changes))
(cond
(= changes :none)
(do
(log/debugf "Group %d no longer has any permissions for Table %d, deleting GTAP for this Table if one exists"
group-id table-id)
(delete-gtaps-with-condition! group-id [:= :table.id table-id]))
(= changes :all)
(do
(log/debugf "Group %d now has full data perms for Table %d, deleting GTAP for this Table if one exists"
group-id table-id)
(delete-gtaps-with-condition! group-id [:= :table.id table-id]))
:else
(let [new-query-perms (get changes :query :none)]
(case new-query-perms
:none
(do
(log/debugf "Group %d no longer has any query perms for Table %d; deleting GTAP for this Table if one exists"
group-id table-id)
(delete-gtaps-with-condition! group-id [:= :table.id table-id]))
:all
(do
(log/debugf "Group %d now has full non-sandboxed query perms for Table %d; deleting GTAP for this Table if one exists"
group-id table-id)
(delete-gtaps-with-condition! group-id [:= :table.id table-id]))
:segmented
(log/debugf "Group %d now has full segmented query perms for Table %d. Do not need to delete GTAPs."
group-id table-id))))) | |
(defn- delete-gtaps-for-group-schema! [{:keys [group-id database-id schema-name], :as context} changes]
(log/debugf "Deleting unneeded GTAPs for Group %d for Database %d, schema %s. Graph changes: %s"
group-id database-id (pr-str schema-name) (pr-str changes))
(cond
(= changes :none)
(do
(log/debugf "Group %d no longer has any permissions for Database %d schema %s, deleting all GTAPs for this schema"
group-id database-id (pr-str schema-name))
(delete-gtaps-with-condition! group-id [:and [:= :table.db_id database-id] [:= :table.schema schema-name]]))
(= changes :all)
(do
(log/debugf "Group %d changes has full data perms for Database %d schema %s, deleting all GTAPs for this schema"
group-id database-id (pr-str schema-name))
(delete-gtaps-with-condition! group-id [:and [:= :table.db_id database-id] [:= :table.schema schema-name]]))
:else
(doseq [table-id (set (keys changes))]
(delete-gtaps-for-group-table! (assoc context :table-id table-id) (get changes table-id))))) | |
(defn- delete-gtaps-for-group-database! [{:keys [group-id database-id], :as context} changes]
(log/debugf "Deleting unneeded GTAPs for Group %d for Database %d. Graph changes: %s"
group-id database-id (pr-str changes))
(if (#{:none :all :block :impersonated} changes)
(do
(log/debugf "Group %d %s for Database %d, deleting all GTAPs for this DB"
group-id
(case changes
:none "no longer has any perms"
:all "now has full data perms"
:block "is now BLOCKED from all non-data-perms access")
database-id)
(delete-gtaps-with-condition! group-id [:= :table.db_id database-id]))
(doseq [schema-name (set (keys changes))]
(delete-gtaps-for-group-schema!
(assoc context :schema-name schema-name)
(get changes schema-name))))) | |
(defn- delete-gtaps-for-group! [{:keys [group-id]} changes]
(log/debugf "Deleting unneeded GTAPs for Group %d. Graph changes: %s" group-id (pr-str changes))
(doseq [database-id (set (keys changes))]
(when-let [data-perm-changes (get-in changes [database-id :data :schemas])]
(delete-gtaps-for-group-database!
{:group-id group-id, :database-id database-id}
data-perm-changes)))) | |
For use only inside | (defenterprise delete-gtaps-if-needed-after-permissions-change!
:feature :sandboxes
[changes]
(log/debug "Permissions updated, deleting unneeded GTAPs...")
(doseq [group-id (set (keys changes))]
(delete-gtaps-for-group! {:group-id group-id} (get changes group-id)))
(log/debug "Done deleting unneeded GTAPs.")) |
(ns metabase-enterprise.sandbox.query-processor.middleware.column-level-perms-check (:require [medley.core :as m] [metabase.api.common :refer [*current-user-id*]] [metabase.mbql.util :as mbql.u] [metabase.public-settings.premium-features :refer [defenterprise]] [metabase.util.i18n :refer [trs tru]] [metabase.util.log :as log])) | |
(defn- field-ids [form]
(set (mbql.u/match form
[:field (id :guard integer?) _]
id))) | |
(defn- maybe-apply-column-level-perms-check*
{:arglists '([query context])}
[{{{source-query-fields :fields} :source-query} :query, :as query} {:keys [gtap-perms]}]
(let [restricted-field-ids (and gtap-perms
(field-ids source-query-fields))]
(when (seq restricted-field-ids)
(let [fields-ids-in-query (field-ids (m/dissoc-in query [:query :source-query]))]
(when-not (every? restricted-field-ids fields-ids-in-query)
(log/warn (trs "User ''{0}'' attempted to access an inaccessible field. Accessible fields {1}, fields in query {2}"
*current-user-id* (pr-str restricted-field-ids) (pr-str fields-ids-in-query)))
(throw (ex-info (str (tru "User not able to query field")) {:status 403}))))))) | |
Check column-level permissions if applicable. | (defenterprise maybe-apply-column-level-perms-check
:feature :sandboxes
[qp]
(fn [query rff context]
(maybe-apply-column-level-perms-check* query context)
(qp query rff context))) |
Apply segmented a.k.a. sandboxing anti-permissions to the query, i.e. replace sandboxed Tables with the appropriate [[metabase-enterprise.sandbox.models.group-table-access-policy]]s (GTAPs). See dox for [[metabase.models.permissions]] for a high-level overview of the Metabase permissions system. | (ns metabase-enterprise.sandbox.query-processor.middleware.row-level-restrictions
(:require
[clojure.core.memoize :as memoize]
[medley.core :as m]
[metabase-enterprise.sandbox.api.util :as mt.api.u]
[metabase-enterprise.sandbox.models.group-table-access-policy
:as gtap
:refer [GroupTableAccessPolicy]]
[metabase.api.common :as api :refer [*current-user* *current-user-id*]]
[metabase.db.connection :as mdb.connection]
[metabase.lib.metadata :as lib.metadata]
[metabase.lib.metadata.protocols :as lib.metadata.protocols]
[metabase.mbql.schema :as mbql.s]
[metabase.mbql.util :as mbql.u]
[metabase.models.card :refer [Card]]
[metabase.models.permissions :as perms]
[metabase.models.permissions-group-membership
:refer [PermissionsGroupMembership]]
[metabase.models.query.permissions :as query-perms]
[metabase.permissions.util :as perms.u]
[metabase.plugins.classloader :as classloader]
[metabase.public-settings.premium-features :refer [defenterprise]]
[metabase.query-processor.error-type :as qp.error-type]
[metabase.query-processor.middleware.fetch-source-query
:as fetch-source-query]
[metabase.query-processor.middleware.permissions :as qp.perms]
[metabase.query-processor.store :as qp.store]
[metabase.util :as u]
[metabase.util.i18n :refer [trs tru]]
[metabase.util.log :as log]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
#_{:clj-kondo/ignore [:discouraged-namespace]}
[toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
(comment mdb.connection/keep-me) ; used for [[memoize/ttl]] | |
+----------------------------------------------------------------------------------------------------------------+ | query->gtap | +----------------------------------------------------------------------------------------------------------------+ | |
(defn- all-table-ids [m]
(into #{} cat (mbql.u/match m
(_ :guard (every-pred map? :source-table (complement ::gtap?)))
(let [recursive-ids (all-table-ids (dissoc &match :source-table))]
(cons (:source-table &match) recursive-ids))))) | |
(defn- query->all-table-ids [query]
(let [ids (all-table-ids query)]
(when (seq ids)
(qp.store/bulk-metadata :metadata/table ids)
(set ids)))) | |
Make sure all referenced Tables have at most one GTAP. | (defn assert-one-gtap-per-table
[gtaps]
(doseq [[table-id gtaps] (group-by :table_id gtaps)
:when (> (count gtaps) 1)]
(throw (ex-info (tru "Found more than one group table access policy for user ''{0}''"
(:email @*current-user*))
{:type qp.error-type/client
:table-id table-id
:gtaps gtaps
:user *current-user-id*
:group-ids (map :group_id gtaps)})))) |
(defn- tables->sandboxes [table-ids]
(qp.store/cached [*current-user-id* table-ids]
(let [group-ids (qp.store/cached *current-user-id*
(t2/select-fn-set :group_id PermissionsGroupMembership :user_id *current-user-id*))
sandboxes (when (seq group-ids)
(t2/select GroupTableAccessPolicy :group_id [:in group-ids]
:table_id [:in table-ids]))
enforced-sandboxes (mt.api.u/enforced-sandboxes sandboxes group-ids)]
(when (seq enforced-sandboxes)
(assert-one-gtap-per-table enforced-sandboxes)
enforced-sandboxes)))) | |
(defn- query->table-id->gtap [query]
{:pre [(some? *current-user-id*)]}
(let [table-ids (query->all-table-ids query)
gtaps (some-> table-ids tables->sandboxes)]
(when (seq gtaps)
(m/index-by :table_id gtaps)))) | |
+----------------------------------------------------------------------------------------------------------------+ | Applying a GTAP | +----------------------------------------------------------------------------------------------------------------+ | |
(mu/defn ^:private target-field->base-type :- [:maybe ms/FieldType]
"If the `:target` of a parameter contains a `:field` clause, return the base type corresponding to the Field it
references. Otherwise returns `nil`."
[[_ target-field-clause]]
(when-let [field-id (mbql.u/match-one target-field-clause [:field (field-id :guard integer?) _] field-id)]
(:base-type (lib.metadata.protocols/field (qp.store/metadata-provider) field-id)))) | |
Take an | (defn- attr-value->param-value
[target-type attr-value]
(let [attr-string? (string? attr-value)]
(cond
;; If the attr-value is a string and the target type is integer, parse it as a long
(and attr-string? (isa? target-type :type/Integer))
(parse-long attr-value)
;; If the attr-value is a string and the target type is float, parse it as a double
(and attr-string? (isa? target-type :type/Float))
(parse-double attr-value)
;; No need to parse it if the type isn't numeric or if it's already a number
:else
attr-value))) |
(defn- attr-remapping->parameter [login-attributes [attr-name target]]
(let [attr-value (get login-attributes attr-name)
field-base-type (target-field->base-type target)]
(when (not attr-value)
(throw (ex-info (tru "Query requires user attribute `{0}`" (name attr-name))
{:type qp.error-type/missing-required-parameter})))
{:type :category
:target target
:value (attr-value->param-value field-base-type attr-value)})) | |
(defn- gtap->parameters [{attribute-remappings :attribute_remappings}]
(mapv (partial attr-remapping->parameter (:login_attributes @*current-user*))
attribute-remappings)) | |
(mu/defn ^:private preprocess-source-query :- mbql.s/SourceQuery
[source-query :- mbql.s/SourceQuery]
(try
(let [query {:database (u/the-id (lib.metadata/database (qp.store/metadata-provider)))
:type :query
:query source-query}
preprocessed (binding [*current-user-id* nil]
(classloader/require 'metabase.query-processor)
((resolve 'metabase.query-processor/preprocess) query))]
(select-keys (:query preprocessed) [:source-query :source-metadata]))
(catch Throwable e
(throw (ex-info (tru "Error preprocessing source query when applying GTAP: {0}" (ex-message e))
{:source-query source-query}
e))))) | |
(defn- card-gtap->source
[{card-id :card_id :as gtap}]
(update-in (fetch-source-query/card-id->source-query-and-metadata card-id)
[:source-query :parameters]
concat
(gtap->parameters gtap))) | |
(defn- table-gtap->source [{table-id :table_id, :as gtap}]
{:source-query {:source-table table-id, :parameters (gtap->parameters gtap)}}) | |
(mu/defn ^:private mbql-query-metadata :- [:+ :map]
[inner-query]
(binding [*current-user-id* nil]
((requiring-resolve 'metabase.query-processor/query->expected-cols)
{:database (u/the-id (lib.metadata/database (qp.store/metadata-provider)))
:type :query
:query inner-query}))) | |
cache the original metadata for a little bit so we don't have to preprocess a query every time we apply sandboxing | (def ^:private ^{:arglists '([table-id])} original-table-metadata
(memoize/ttl
^{::memoize/args-fn (fn [[table-id]]
[(mdb.connection/unique-identifier) table-id])}
(fn [table-id]
(mbql-query-metadata {:source-table table-id}))
:ttl/threshold (u/minutes->ms 1))) |
(mu/defn ^:private reconcile-metadata :- [:+ :map]
"Combine the metadata in `source-query-metadata` with the `table-metadata` from the Table being sandboxed."
[source-query-metadata :- [:+ :map] table-metadata]
(let [col-name->table-metadata (m/index-by :name table-metadata)]
(vec
(for [col source-query-metadata
:let [table-col (get col-name->table-metadata (:name col))]
:when table-col]
(do
(gtap/check-column-types-match col table-col)
table-col))))) | |
(mu/defn ^:private native-query-metadata :- [:+ :map]
[source-query :- [:map [:source-query :any]]]
(let [result (binding [*current-user-id* nil]
((requiring-resolve 'metabase.query-processor/process-query)
{:database (u/the-id (lib.metadata/database (qp.store/metadata-provider)))
:type :query
:query {:source-query source-query
:limit 0}}))]
(or (-> result :data :results_metadata :columns not-empty)
(throw (ex-info (tru "Error running query to determine metadata")
{:source-query source-query
:result result}))))) | |
(mu/defn ^:private source-query-form-ensure-metadata :- [:and [:map-of :keyword :any]
[:map
[:source-query :any]
[:source-metadata [:+ :map]]]]
"Add `:source-metadata` to a `source-query` if needed. If the source metadata had to be resolved (because Card with
`card-id`) didn't already have it, save it so we don't have to resolve it again next time around."
[{:keys [source-metadata], :as source-query} :- [:and [:map-of :keyword :any] [:map [:source-query :any]]]
table-id :- ms/PositiveInt
card-id :- [:maybe ms/PositiveInt]]
(let [table-metadata (original-table-metadata table-id)
;; make sure source query has `:source-metadata`; add it if needed
[metadata save?] (cond
;; if it already has `:source-metadata`, we're good to go.
(seq source-metadata)
[source-metadata false]
;; if it doesn't have source metadata, but it's an MBQL query, we can preprocess the query to
;; get the expected metadata.
(not (get-in source-query [:source-query :native]))
[(mbql-query-metadata source-query) true]
;; otherwise if it's a native query we'll have to run the query really quickly to get the
;; expected metadata.
:else
[(native-query-metadata source-query) true])
metadata (reconcile-metadata metadata table-metadata)]
(assert (seq metadata))
;; save the result metadata so we don't have to do it again next time if applicable
(when (and card-id save?)
(log/tracef "Saving results metadata for GTAP Card %s" card-id)
(t2/update! Card card-id {:result_metadata metadata}))
;; make sure the fetched Fields are present the QP store
(when-let [field-ids (not-empty (filter some? (map :id metadata)))]
(qp.store/bulk-metadata :metadata/column field-ids))
(assoc source-query :source-metadata metadata))) | |
(mu/defn ^:private gtap->source :- [:map
[:source-query :any]
[:source-metadata {:optional true} [:sequential mbql.s/SourceQueryMetadata]]]
"Get the source query associated with a `gtap`."
[{card-id :card_id, table-id :table_id, :as gtap} :- :map]
(-> ((if card-id
card-gtap->source
table-gtap->source) gtap)
preprocess-source-query
(source-query-form-ensure-metadata table-id card-id))) | |
Returns the set of table IDs which are used by the given sandbox. These are the sandboxed table itself, as well as any linked tables referenced via fields in the attribute remappings. This is the set of tables which need to be excluded from subsequent permission checks in order to run the sandboxed query. | (defn- sandbox->table-ids
[{table-id :table_id, attribute-remappings :attribute_remappings}]
(->>
(for [target-field-clause (vals attribute-remappings)]
(mbql.u/match-one target-field-clause
[:field (field-id :guard integer?) _]
(:table-id (lib.metadata.protocols/field (qp.store/metadata-provider) field-id))))
(cons table-id)
(remove nil?)
set)) |
(mu/defn ^:private sandbox->perms-set :- [:set perms.u/PathSchema]
"Calculate the set of permissions needed to run the query associated with a sandbox; this set of permissions is excluded
during the normal QP perms check.
Background: when applying sandboxing, we don't want the QP perms check middleware to throw an Exception if the Current
User doesn't have permissions to run the underlying sandboxed query, which will likely be greater than what they
actually have. (For example, a User might have sandboxed query perms for Table 15, which is why we're applying a
sandbox in the first place; the actual perms required to normally run the underlying sandbox query is more likely
something like *full* query perms for Table 15.) The QP perms check middleware subtracts this set from the set of
required permissions, allowing the user to run their sandboxed query."
[{card-id :card_id :as sandbox}]
(if card-id
(qp.store/cached card-id
(query-perms/perms-set (:dataset-query (lib.metadata.protocols/card (qp.store/metadata-provider) card-id))
:throw-exceptions? true))
(set (map perms/table-query-path (sandbox->table-ids sandbox))))) | |
(defn- sandboxes->perms-set [sandboxes] (set (mapcat sandbox->perms-set sandboxes))) | |
+----------------------------------------------------------------------------------------------------------------+ | Middleware | +----------------------------------------------------------------------------------------------------------------+ | |
------------------------------------------ apply-row-level-permissions ------------------------------------------- | |
Apply a GTAP to map m (e.g. a Join or inner query), replacing its | (defn- apply-gtap
[m gtap]
;; Only infer source query metadata for JOINS that use `:fields :all`. That's the only situation in which we
;; absolutely *need* to infer source query metadata (we need to know the columns returned by the source query so we
;; can generate the join against ALL fields). It's better not to infer the source metadata if we don't NEED to,
;; because we might be inferring the wrong thing. See comments above -- in practice a GTAP should have the same
;; columns as the Table it replaces, but this constraint is not enforced anywhere. If we infer metadata and the GTAP
;; turns out *not* to match exactly, the query could break. So only infer it in cases where the query would
;; definitely break otherwise.
(u/prog1 (merge
(dissoc m :source-table :source-query)
(gtap->source gtap))
(log/tracef "Applied GTAP: replaced\n%swith\n%s"
(u/pprint-to-str 'yellow m)
(u/pprint-to-str 'green <>)))) |
Replace | (defn- apply-gtaps
[m table-id->gtap]
;; replace maps that have `:source-table` key and a matching entry in `table-id->gtap`, but do not have `::gtap?` key
(mbql.u/replace m
(_ :guard (every-pred map? (complement ::gtap?) :source-table #(get table-id->gtap (:source-table %))))
(let [updated (apply-gtap &match (get table-id->gtap (:source-table &match)))
;; now recursively apply gtaps anywhere else they might exist at this level, e.g. `:joins`
recursively-updated (merge
(select-keys updated [:source-table :source-query])
(apply-gtaps (dissoc updated :source-table :source-query) table-id->gtap))]
;; add a `::gtap?` key next to every `:source-table` key so when we do a second pass after adding JOINs they
;; don't get processed again
(mbql.u/replace recursively-updated
(_ :guard (every-pred map? :source-table))
(assoc &match ::gtap? true))))) |
(defn- expected-cols [query]
(binding [*current-user-id* nil]
((requiring-resolve 'metabase.query-processor/query->expected-cols) query))) | |
Apply GTAPs to | (defn- gtapped-query
[original-query table-id->gtap]
(let [sandboxed-query (apply-gtaps original-query table-id->gtap)]
(if (= sandboxed-query original-query)
original-query
(-> sandboxed-query
(assoc ::original-metadata (expected-cols original-query))
(update-in [::qp.perms/perms :gtaps] (fn [perms] (into (set perms) (sandboxes->perms-set (vals table-id->gtap))))))))) |
(def ^:private default-recursion-limit 20) (def ^:private ^:dynamic *recursion-limit* default-recursion-limit) | |
Pre-processing middleware. Replaces source tables a User was querying against with source queries that (presumably) restrict the rows returned, based on presence of sandboxes. | (defenterprise apply-sandboxing
:feature :sandboxes
[query]
(if-not api/*is-superuser?*
(or (when-let [table-id->gtap (when *current-user-id*
(query->table-id->gtap query))]
(let [gtapped-query (gtapped-query query table-id->gtap)]
(if (not= query gtapped-query)
;; Applying GTAPs to the query may have introduced references to tables that are also sandboxed,
;; so we need to recursively appby the middleware until new queries are not returned.
(if (= *recursion-limit* 0)
(throw (ex-info (trs "Reached recursion limit of {0} in \"apply-sandboxing\" middleware"
default-recursion-limit)
query))
(binding [*recursion-limit* (dec *recursion-limit*)]
(apply-sandboxing gtapped-query)))
gtapped-query)))
query)
query)) |
Post-processing | |
Merge column metadata from the non-sandboxed version of the query into the sandboxed results | (defn- merge-metadata
[original-metadata metadata]
(letfn [(merge-cols [cols]
(let [col-name->expected-col (m/index-by :name original-metadata)]
(for [col cols]
(merge
col
(get col-name->expected-col (:name col))))))]
(update metadata :cols merge-cols))) |
Post-processing middleware. Merges in column metadata from the original, unsandboxed version of the query. | (defenterprise merge-sandboxing-metadata
:feature :sandboxes
[{::keys [original-metadata] :as query} rff]
(fn merge-sandboxing-metadata-rff* [metadata]
(let [metadata (assoc metadata :is_sandboxed (some? (get-in query [::qp.perms/perms :gtaps])))
metadata (if original-metadata
(merge-metadata original-metadata metadata)
metadata)]
(rff metadata)))) |
(ns metabase-enterprise.search.scoring ;; TODO -- move to `metabase-enterprise.<feature>.*` (:require [metabase.public-settings.premium-features :as premium-features :refer [defenterprise]] [metabase.search.scoring :as scoring])) | |
A scorer for items in official collections | (defn- official-collection-score
[{:keys [collection_authority_level]}]
(if (contains? #{"official"} collection_authority_level)
1
0)) |
A scorer for verified items. | (defn- verified-score
[{:keys [moderated_status]}]
(if (contains? #{"verified"} moderated_status)
1
0)) |
Scoring implementation that adds score for items in official collections. | (defenterprise score-result
:feature :none
[result]
(cond-> (scoring/weights-and-scores result)
(premium-features/has-feature? :official-collections)
(conj {:weight 2
:score (official-collection-score result)
:name "official collection score"})
(premium-features/has-feature? :content-verification)
(conj {:weight 2
:score (verified-score result)
:name "verified"}))) |
(ns metabase-enterprise.serialization.api (:require [clojure.java.io :as io] [compojure.core :refer [POST]] [java-time.api :as t] [metabase-enterprise.serialization.v2.extract :as extract] [metabase-enterprise.serialization.v2.ingest :as v2.ingest] [metabase-enterprise.serialization.v2.load :as v2.load] [metabase-enterprise.serialization.v2.storage :as storage] [metabase.api.common :as api] [metabase.api.routes.common :refer [+auth]] [metabase.logger :as logger] [metabase.models.serialization :as serdes] [metabase.public-settings :as public-settings] [metabase.util :as u] [metabase.util.compress :as u.compress] [metabase.util.date-2 :as u.date] [metabase.util.log :as log] [metabase.util.malli.schema :as ms] [metabase.util.random :as u.random] [ring.core.protocols :as ring.protocols]) (:import (java.io File ByteArrayOutputStream))) | |
(set! *warn-on-reflection* true) | |
Storage | |
Dir for storing serialization API export-in-progress and archives. | (def parent-dir
(let [f (io/file (System/getProperty "java.io.tmpdir") (str "serdesv2-" (u.random/random-name)))]
(.mkdirs f)
(.deleteOnExit f)
(.getPath f))) |
Request callbacks | |
(defn- ba-copy [f]
(with-open [baos (ByteArrayOutputStream.)]
(io/copy f baos)
(.toByteArray baos))) | |
(defn- on-response! [data callback]
(reify
;; Real HTTP requests and mt/user-real-request go here
ring.protocols/StreamableResponseBody
(write-body-to-stream [_ response out]
(ring.protocols/write-body-to-stream data response out)
(future (callback)))
;; mt/user-http-request goes here
clojure.java.io.IOFactory
(make-input-stream [_ _]
(let [res (io/input-stream (if (instance? File data)
(ba-copy data)
data))]
(callback)
res)))) | |
Logic | |
(defn- serialize&pack ^File [{:keys [dirname] :as opts}]
(let [dirname (or dirname
(format "%s-%s"
(u/slugify (public-settings/site-name))
(u.date/format "YYYY-MM-dd_HH-mm" (t/local-date-time))))
path (io/file parent-dir dirname)
dst (io/file (str (.getPath path) ".tar.gz"))
log-file (io/file path "export.log")]
(with-open [_logger (logger/for-ns 'metabase-enterprise.serialization log-file)]
(try ; try/catch inside logging to log errors
(serdes/with-cache
(-> (extract/extract opts)
(storage/store! path)))
;; not removing storage immediately to save some time before response
(u.compress/tgz path dst)
(catch Exception e
(log/error e "Error during serialization"))))
{:archive (when (.exists dst)
dst)
:log-file (when (.exists log-file)
log-file)
:callback (fn []
(when (.exists path)
(run! io/delete-file (reverse (file-seq path))))
(when (.exists dst)
(io/delete-file dst)))})) | |
(defn- unpack&import [^File file & [size]]
(let [dst (io/file parent-dir (u.random/random-name))
log-file (io/file dst "import.log")]
(with-open [_logger (logger/for-ns 'metabase-enterprise.serialization log-file)]
(try ; try/catch inside logging to log errors
(log/infof "Serdes import, size %s" size)
(let [path (u.compress/untgz file dst)]
(serdes/with-cache
(-> (v2.ingest/ingest-yaml (.getPath (io/file dst path)))
(v2.load/load-metabase! {:abort-on-error true}))))
(catch Exception e
(log/error e "Error during serialization"))))
{:log-file log-file
:callback #(when (.exists dst)
(run! io/delete-file (reverse (file-seq dst))))})) | |
HTTP API | |
/export | (api/defendpoint POST
"Serialize and retrieve Metabase instance.
Parameters:
- `dirname`: str, name of directory and archive file (default: `<instance-name>-<YYYY-MM-dd_HH-mm>`)
- `all_collections`: bool, serialize all collections (default: true, unless you specify `collection`)
- `collection`: array of int, db id of a collection to serialize
- `settings`: bool, if Metabase settings should be serialized (default: `true`)
- `data_model`: bool, if Metabase data model should be serialized (default: `true`)
- `field_values`: bool, if cached field values should be serialized (default: `false`)
- `database_secrets`: bool, if details how to connect to each db should be serialized (default: `false`)
Outputs .tar.gz file with serialization results and an `export.log` file.
On error just returns serialization logs."
[:as {{:strs [all_collections collection settings data_model field_values database_secrets dirname]
:or {all_collections true
settings true
data_model true}}
:query-params}]
{collection [:maybe [:vector {:decode/string (fn [x] (cond (vector? x) x x [x]))} ms/PositiveInt]]
all_collections [:maybe ms/BooleanValue]
settings [:maybe ms/BooleanValue]
data_model [:maybe ms/BooleanValue]
field_values [:maybe ms/BooleanValue]
database_secrets [:maybe ms/BooleanValue]}
(api/check-superuser)
(let [opts {:targets (mapv #(vector "Collection" %)
collection)
:no-collections (and (empty? collection)
(not all_collections))
:no-data-model (not data_model)
:no-settings (not settings)
:include-field-values field_values
:include-database-secrets database_secrets
:dirname dirname}
{:keys [archive
log-file
callback]} (serialize&pack opts)]
(if archive
{:status 200
:headers {"Content-Type" "application/gzip"
"Content-Disposition" (format "attachment; filename=\"%s\"" (.getName ^File archive))}
:body (on-response! archive callback)}
{:status 500
:headers {"Content-Type" "text/plain"}
:body (on-response! log-file callback)}))) |
/import | (api/defendpoint ^:multipart POST
"Deserialize Metabase instance from an archive generated by /export.
Parameters:
- `file`: archive encoded as `multipart/form-data` (required).
Returns logs of deserialization."
[:as {raw-params :params}]
(api/check-superuser)
(try
(let [{:keys [log-file callback]} (unpack&import (get-in raw-params ["file" :tempfile])
(get-in raw-params ["file" :size]))]
{:status 200
:headers {"Content-Type" "text/plain"}
:body (on-response! log-file callback)})
(finally
(io/delete-file (get-in raw-params ["file" :tempfile]))))) |
(api/define-routes +auth) | |
(ns metabase-enterprise.serialization.cmd (:refer-clojure :exclude [load]) (:require [clojure.java.io :as io] [metabase-enterprise.serialization.dump :as dump] [metabase-enterprise.serialization.load :as load] [metabase-enterprise.serialization.v2.entity-ids :as v2.entity-ids] [metabase-enterprise.serialization.v2.extract :as v2.extract] [metabase-enterprise.serialization.v2.ingest :as v2.ingest] [metabase-enterprise.serialization.v2.load :as v2.load] [metabase-enterprise.serialization.v2.storage :as v2.storage] [metabase.db :as mdb] [metabase.models.card :refer [Card]] [metabase.models.collection :refer [Collection]] [metabase.models.dashboard :refer [Dashboard]] [metabase.models.database :refer [Database]] [metabase.models.field :as field :refer [Field]] [metabase.models.metric :refer [Metric]] [metabase.models.native-query-snippet :refer [NativeQuerySnippet]] [metabase.models.pulse :refer [Pulse]] [metabase.models.segment :refer [Segment]] [metabase.models.serialization :as serdes] [metabase.models.table :refer [Table]] [metabase.models.user :refer [User]] [metabase.plugins :as plugins] [metabase.public-settings.premium-features :as premium-features] [metabase.util :as u] [metabase.util.i18n :refer [deferred-trs trs]] [metabase.util.log :as log] [metabase.util.malli :as mu] [toucan2.core :as t2])) | |
(set! *warn-on-reflection* true) | |
(def ^:private Mode
(mu/with-api-error-message [:enum :skip :update]
(deferred-trs "invalid --mode value"))) | |
(def ^:private OnError
(mu/with-api-error-message [:enum :continue :abort]
(deferred-trs "invalid --on-error value"))) | |
(def ^:private Context
(mu/with-api-error-message
[:map {:closed true}
[:on-error {:optional true} OnError]
[:mode {:optional true} Mode]]
(deferred-trs "invalid context seed value"))) | |
(defn- check-premium-token! [] (premium-features/assert-has-feature :serialization (trs "Serialization"))) | |
Load serialized metabase instance as created by [[dump]] command from directory | (mu/defn v1-load!
[path context :- Context]
(plugins/load-plugins!)
(mdb/setup-db!)
(check-premium-token!)
(when-not (load/compatible? path)
(log/warn (trs "Dump was produced using a different version of Metabase. Things may break!")))
(let [context (merge {:mode :skip
:on-error :continue}
context)]
(try
(log/info (trs "BEGIN LOAD from {0} with context {1}" path context))
(let [all-res [(load/load! (str path "/users") context)
(load/load! (str path "/databases") context)
(load/load! (str path "/collections") context)
(load/load-settings! path context)]
reload-fns (filter fn? all-res)]
(when (seq reload-fns)
(log/info (trs "Finished first pass of load; now performing second pass"))
(doseq [reload-fn reload-fns]
(reload-fn)))
(log/info (trs "END LOAD from {0} with context {1}" path context)))
(catch Throwable e
(log/error e (trs "ERROR LOAD from {0}: {1}" path (.getMessage e)))
(throw e))))) |
SerDes v2 load entry point for internal users.
| (mu/defn v2-load-internal!
[path :- :string
opts :- [:map
[:abort-on-error {:optional true} [:maybe :boolean]]
[:backfill? {:optional true} [:maybe :boolean]]]
;; Deliberately separate from the opts so it can't be set from the CLI.
& {:keys [token-check?]
:or {token-check? true}}]
(plugins/load-plugins!)
(mdb/setup-db!)
(when token-check?
(check-premium-token!))
; TODO This should be restored, but there's no manifest or other meta file written by v2 dumps.
;(when-not (load/compatible? path)
; (log/warn (trs "Dump was produced using a different version of Metabase. Things may break!")))
(log/info (trs "Loading serialized Metabase files from {0}" path))
(serdes/with-cache
(v2.load/load-metabase! (v2.ingest/ingest-yaml path) opts))) |
SerDes v2 load entry point. opts are passed to load-metabase | (mu/defn v2-load!
[path :- :string
opts :- [:map
[:abort-on-error {:optional true} [:maybe :boolean]]
[:backfill? {:optional true} [:maybe :boolean]]]]
(v2-load-internal! path opts :token-check? true)) |
(defn- select-entities-in-collections
([model collections]
(select-entities-in-collections model collections :all))
([model collections state]
(let [state-filter (case state
:all nil
:active [:= :archived false])]
(t2/select model {:where [:and
[:or [:= :collection_id nil]
(if (not-empty collections)
[:in :collection_id (map u/the-id collections)]
false)]
state-filter]})))) | |
(defn- select-segments-in-tables
([tables]
(select-segments-in-tables tables :all))
([tables state]
(case state
:all
(mapcat #(t2/select Segment :table_id (u/the-id %)) tables)
:active
(filter
#(not (:archived %))
(mapcat #(t2/select Segment :table_id (u/the-id %)) tables))))) | |
Selects the collections for a given user-id, or all collections without a personal ID if the passed user-id is nil.
If | (defn- select-collections
([users]
(select-collections users :active))
([users state]
(let [state-filter (case state
:all nil
:active [:= :archived false])
base-collections (t2/select Collection {:where [:and [:= :location "/"]
[:or [:= :personal_owner_id nil]
[:= :personal_owner_id
(some-> users first u/the-id)]]
state-filter]})]
(if (empty? base-collections)
[]
(-> (t2/select Collection
{:where [:and
(reduce (fn [acc coll]
(conj acc [:like :location (format "/%d/%%" (:id coll))]))
[:or] base-collections)
state-filter]})
(into base-collections)))))) |
Legacy Metabase app data dump | (defn v1-dump!
[path {:keys [state user] :or {state :active} :as opts}]
(log/info (trs "BEGIN DUMP to {0} via user {1}" path user))
(mdb/setup-db!)
(check-premium-token!)
(t2/select User) ;; TODO -- why??? [editor's note: this comment originally from Cam]
(let [users (if user
(let [user (t2/select-one User
:email user
:is_superuser true)]
(assert user (trs "{0} is not a valid user" user))
[user])
[])
databases (if (contains? opts :only-db-ids)
(t2/select Database :id [:in (:only-db-ids opts)] {:order-by [[:id :asc]]})
(t2/select Database))
tables (if (contains? opts :only-db-ids)
(t2/select Table :db_id [:in (:only-db-ids opts)] {:order-by [[:id :asc]]})
(t2/select Table))
fields (if (contains? opts :only-db-ids)
(t2/select Field :table_id [:in (map :id tables)] {:order-by [[:id :asc]]})
(t2/select Field))
metrics (if (contains? opts :only-db-ids)
(t2/select Metric :table_id [:in (map :id tables)] {:order-by [[:id :asc]]})
(t2/select Metric))
collections (select-collections users state)]
(dump/dump! path
databases
tables
(mapcat field/with-values (u/batches-of 32000 fields))
metrics
(select-segments-in-tables tables state)
collections
(select-entities-in-collections NativeQuerySnippet collections state)
(select-entities-in-collections Card collections state)
(select-entities-in-collections Dashboard collections state)
(select-entities-in-collections Pulse collections state)
users))
(dump/dump-settings! path)
(dump/dump-dimensions! path)
(log/info (trs "END DUMP to {0} via user {1}" path user))) |
Exports Metabase app data to directory at path | (defn v2-dump!
[path {:keys [collection-ids] :as opts}]
(log/info (trs "Exporting Metabase to {0}" path) (u/emoji "🏭 🚛💨"))
(mdb/setup-db!)
(check-premium-token!)
(t2/select User) ;; TODO -- why??? [editor's note: this comment originally from Cam]
(let [f (io/file path)]
(.mkdirs f)
(when-not (.canWrite f)
(throw (ex-info (format "Destination path is not writeable: %s" path) {:filename path}))))
(serdes/with-cache
(-> (cond-> opts
(seq collection-ids) (assoc :targets (v2.extract/make-targets-of-type "Collection" collection-ids)))
v2.extract/extract
(v2.storage/store! path)))
(log/info (trs "Export to {0} complete!" path) (u/emoji "🚛💨 📦"))
::v2-dump-complete) |
Add entity IDs for instances of serializable models that don't already have them. Returns truthy if all entity IDs were added successfully, or falsey if any errors were encountered. | (defn seed-entity-ids! [] (v2.entity-ids/seed-entity-ids!)) |
Drop entity IDs for all instances of serializable models. This is needed for some cases of migrating from v1 to v2 serdes. v1 doesn't dump Returns truthy if all entity IDs have been dropped, or falsey if any errors were encountered. | (defn drop-entity-ids! [] (v2.entity-ids/drop-entity-ids!)) |
Serialize entities into a directory structure of YAMLs. | (ns metabase-enterprise.serialization.dump
(:require
[clojure.edn :as edn]
[clojure.java.io :as io]
[metabase-enterprise.serialization.names
:refer [fully-qualified-name name-for-logging safe-name]]
[metabase-enterprise.serialization.serialize :as serialize]
[metabase.config :as config]
[metabase.models.dashboard :refer [Dashboard]]
[metabase.models.database :refer [Database]]
[metabase.models.dimension :refer [Dimension]]
[metabase.models.field :refer [Field]]
[metabase.models.interface :as mi]
[metabase.models.metric :refer [Metric]]
[metabase.models.pulse :refer [Pulse]]
[metabase.models.segment :refer [Segment]]
[metabase.models.setting :as setting]
[metabase.models.table :refer [Table]]
[metabase.models.user :refer [User]]
[metabase.util.i18n :as i18n :refer [trs]]
[metabase.util.log :as log]
[metabase.util.yaml :as yaml]
[toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
(def ^:private serialization-order
(delay (-> (edn/read-string (slurp (io/resource "serialization-order.edn")))
(update-vals (fn [order]
(into {} (map vector order (range)))))))) | |
(defn- serialization-sorted-map* [order-key]
(if-let [order (or (get @serialization-order order-key)
(get @serialization-order (last order-key)))]
;; known columns are sorted by their order, then unknown are sorted alphabetically
(let [getter #(if (contains? order %)
[0 (get order %)]
[1 %])]
(sorted-map-by (fn [k1 k2]
(compare (getter k1) (getter k2)))))
(sorted-map))) | |
(def ^:private serialization-sorted-map (memoize serialization-sorted-map*)) | |
(defn- serialization-deep-sort
([m]
(let [model (-> (:serdes/meta m) last :model)]
(serialization-deep-sort m [(keyword model)])))
([m path]
(into (serialization-sorted-map path)
(for [[k v] m]
[k (cond
(map? v) (serialization-deep-sort v (conj path k))
(and (sequential? v)
(map? (first v))) (mapv #(serialization-deep-sort % (conj path k)) v)
:else v)])))) | |
Writes obj to filename and creates parent directories if necessary. Writes (even nested) yaml keys in a deterministic fashion. | (defn spit-yaml!
[filename obj]
(io/make-parents filename)
(try
(spit filename (yaml/generate-string (serialization-deep-sort obj)
{:dumper-options {:flow-style :block :split-lines false}}))
(catch Exception e
(if-not (.canWrite (.getParentFile (io/file filename)))
(throw (ex-info (format "Destination path is not writeable: %s" filename) {:filename filename}))
(throw e))))) |
(defn- as-file?
[instance]
(some (fn [model]
(mi/instance-of? model instance))
[Pulse Dashboard Metric Segment Field User])) | |
(defn- spit-entity!
[path entity]
(let [filename (if (as-file? entity)
(format "%s%s.yaml" path (fully-qualified-name entity))
(format "%s%s/%s.yaml" path (fully-qualified-name entity) (safe-name entity)))]
(when (.exists (io/as-file filename))
(log/warn (str filename " is about to be overwritten."))
(log/debug (str "With object: " (pr-str entity))))
(spit-yaml! filename (serialize/serialize entity)))) | |
Serialize entities into a directory structure of YAMLs at | (defn dump!
[path & entities]
(doseq [entity (flatten entities)]
(try
(spit-entity! path entity)
(catch Throwable e
(log/error e (trs "Error dumping {0}" (name-for-logging entity))))))
(spit-yaml! (str path "/manifest.yaml")
{:serialization-version serialize/serialization-protocol-version
:metabase-version config/mb-version-info})) |
Combine all settings into a map and dump it into YAML at | (defn dump-settings!
[path]
(spit-yaml! (str path "/settings.yaml")
(into {} (for [{:keys [key value]} (setting/admin-writable-site-wide-settings
:getter (partial setting/get-value-of-type :string))]
[key value])))) |
Combine all dimensions into a vector and dump it into YAML at in the directory for the
corresponding schema starting at | (defn dump-dimensions!
[path]
(doseq [[table-id dimensions] (group-by (comp :table_id Field :field_id) (t2/select Dimension))
:let [table (t2/select-one Table :id table-id)]]
(spit-yaml! (if (:schema table)
(format "%s%s/schemas/%s/dimensions.yaml"
path
(->> table :db_id (fully-qualified-name Database))
(:schema table))
(format "%s%s/dimensions.yaml"
path
(->> table :db_id (fully-qualified-name Database))))
(map serialize/serialize dimensions)))) |
Load entities serialized by | (ns metabase-enterprise.serialization.load
(:refer-clojure :exclude [load])
(:require
[clojure.java.io :as io]
[clojure.string :as str]
[medley.core :as m]
[metabase-enterprise.serialization.names
:as names
:refer [fully-qualified-name->context]]
[metabase-enterprise.serialization.upsert :refer [maybe-upsert-many!]]
[metabase.config :as config]
[metabase.db.connection :as mdb.connection]
[metabase.mbql.normalize :as mbql.normalize]
[metabase.mbql.util :as mbql.u]
[metabase.models.card :refer [Card]]
[metabase.models.collection :refer [Collection]]
[metabase.models.dashboard :refer [Dashboard]]
[metabase.models.dashboard-card :refer [DashboardCard]]
[metabase.models.dashboard-card-series :refer [DashboardCardSeries]]
[metabase.models.database :as database :refer [Database]]
[metabase.models.dimension :refer [Dimension]]
[metabase.models.field :refer [Field]]
[metabase.models.field-values :refer [FieldValues]]
[metabase.models.metric :refer [Metric]]
[metabase.models.native-query-snippet :refer [NativeQuerySnippet]]
[metabase.models.pulse :refer [Pulse]]
[metabase.models.pulse-card :refer [PulseCard]]
[metabase.models.pulse-channel :refer [PulseChannel]]
[metabase.models.segment :refer [Segment]]
[metabase.models.setting :as setting]
[metabase.models.table :refer [Table]]
[metabase.models.user :as user :refer [User]]
[metabase.shared.models.visualization-settings :as mb.viz]
[metabase.util.date-2 :as u.date]
[metabase.util.i18n :refer [trs]]
[metabase.util.log :as log]
[metabase.util.yaml :as yaml]
[toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
(defn- slurp-dir
[path]
(doall
(for [^java.io.File file (.listFiles ^java.io.File (io/file path))
:when (-> file (.getName) (str/ends-with? ".yaml"))]
(yaml/from-file file)))) | |
(defn- slurp-many [paths] (apply concat (map slurp-dir paths))) | |
(defn- list-dirs
[path]
(for [^java.io.File file (.listFiles ^java.io.File (io/file path))
:when (.isDirectory file)]
(.getPath file))) | |
(defn- source-table
[source-table]
(if (and (string? source-table) (str/starts-with? source-table "card__"))
source-table
(let [{:keys [card table]} (fully-qualified-name->context source-table)]
(if card
(str "card__" card)
table)))) | |
Returns true if the given | (defn- fq-table-or-card? [nm] (or (names/fully-qualified-table-name? nm) (names/fully-qualified-card-name? nm))) |
(defn- update-capture-missing*
[m ks resolve-fn get-fn update-fn]
(let [orig-v (get-fn m ks)
res (update-fn m ks resolve-fn)
new-v (get-fn res ks)]
(if (and (some? orig-v) (nil? new-v))
(update res ::unresolved-names #(assoc % orig-v ks))
res))) | |
(defn- update-in-capture-missing [m ks resolve-fn] (update-capture-missing* m ks resolve-fn get-in update-in)) | |
(defn- update-existing-in-capture-missing [m ks resolve-fn] (update-capture-missing* m ks resolve-fn get-in m/update-existing-in)) | |
(defn- update-existing-capture-missing [m k resolve-fn] (update-capture-missing* m [k] resolve-fn get-in m/update-existing-in)) | |
Assocs the given value | (defn- pull-unresolved-names-up
([m ks]
(pull-unresolved-names-up m ks (get-in m ks)))
([m ks v]
(if-let [unresolved-names (::unresolved-names v)]
(-> (update m ::unresolved-names (fn [nms] (merge nms (m/map-vals #(vec (concat ks %)) unresolved-names))))
(assoc-in ks (dissoc v ::unresolved-names)))
(assoc-in m ks v)))) |
Finds all paths to a particular key anywhere in the structure Adapted from: https://dnaeon.github.io/clojure-map-ks-paths/ | (defn- paths-to-key-in
[m match-key]
(letfn [(children [node]
(let [v (get-in m node)]
(cond
(map? v)
(map (fn [x] (conj node x)) (keys v))
(vector? v)
(map (fn [x] (conj node x)) (range (count v)))
:else
[])))
(branch? [node] (-> (children node) seq boolean))]
(->> (keys m)
(map vector)
(mapcat #(tree-seq branch? children %))
(filter #(= match-key (last %)))))) |
This is less efficient than calling | (defn- gather-all-unresolved-names
[m]
(let [paths (paths-to-key-in m ::unresolved-names)]
(if-not (empty? paths)
(reduce (fn [acc ks]
(let [ks* (drop-last ks)]
(if-not (empty? ks*)
(pull-unresolved-names-up acc ks*)
acc)))
m
paths)
m))) |
(defn- mbql-fully-qualified-names->ids*
[entity]
(mbql.u/replace entity
;; handle legacy `:field-id` forms encoded prior to 0.39.0
;; and also *current* expresion forms used in parameter mapping dimensions
;; example relevant clause - [:dimension [:fk-> [:field-id 1] [:field-id 2]]]
[:field-id (fully-qualified-name :guard string?)]
(mbql-fully-qualified-names->ids* [:field fully-qualified-name nil])
[:field (fully-qualified-name :guard names/fully-qualified-field-name?) opts]
[:field (:field (fully-qualified-name->context fully-qualified-name)) (mbql-fully-qualified-names->ids* opts)]
;; source-field is also used within parameter mapping dimensions
;; example relevant clause - [:field 2 {:source-field 1}]
{:source-field (fully-qualified-name :guard string?)}
(assoc &match :source-field (:field (fully-qualified-name->context fully-qualified-name)))
[:metric (fully-qualified-name :guard string?)]
[:metric (:metric (fully-qualified-name->context fully-qualified-name))]
[:segment (fully-qualified-name :guard string?)]
[:segment (:segment (fully-qualified-name->context fully-qualified-name))]
(_ :guard (every-pred map? #(fq-table-or-card? (:source-table %))))
(-> (mbql-fully-qualified-names->ids* (dissoc &match :source-table)) ;; process other keys
(assoc :source-table (:source-table &match)) ;; add :source-table back in for lookup
(update-existing-capture-missing :source-table source-table)))) ;; look up :source-table and capture missing | |
look up :source-table and capture missing | |
(defn- mbql-fully-qualified-names->ids [entity] (mbql-fully-qualified-names->ids* (mbql.normalize/normalize-tokens entity))) | |
(def ^:private ^{:arglists '([])} default-user-id
(mdb.connection/memoize-for-application-db
(fn []
(let [user (t2/select-one-pk User :is_superuser true)]
(assert user (trs "No admin users found! At least one admin user is needed to act as the owner for all the loaded entities."))
user)))) | |
Return the last path component (presumably a dir) | (defn- terminal-dir [path] (.getName (io/file path))) |
(defn- unresolved-names->string
([model]
(unresolved-names->string model nil))
([model insert-id]
(str
(when-let [nm (:name model)] (str "\ nm "\))
(when insert-id (format " (inserted as ID %d) " insert-id))
"missing:\n "
(str/join
"\n "
(map
(fn [[k v]]
(format "at %s -> %s" (str/join "/" v) k))
(::unresolved-names model)))))) | |
Load an entity of type Passing in parent entities as context instead of decoding them from the path each time, saves a lot of queriying. | (defmulti load!
{:arglists '([path context])}
(fn [path _context]
(terminal-dir path))) |
(defn- load-dimensions!
[path context]
(maybe-upsert-many! context Dimension
(for [dimension (yaml/from-file (str path "/dimensions.yaml"))]
(-> dimension
(update :human_readable_field_id (comp :field fully-qualified-name->context))
(update :field_id (comp :field fully-qualified-name->context)))))) | |
(defmethod load! "databases"
[path context]
(doseq [path (list-dirs path)]
;; If we failed to load the DB no use in trying to load its tables
(when-let [db (first (maybe-upsert-many! context Database (slurp-dir path)))]
(doseq [inner-path (conj (list-dirs (str path "/schemas")) path)
:let [context (merge context {:database db
:schema (when (not= inner-path path)
(terminal-dir path))})]]
(load! (str inner-path "/tables") context)
(load-dimensions! inner-path context))))) | |
(defmethod load! "tables"
[path context]
(let [paths (list-dirs path)
table-ids (maybe-upsert-many! context Table
(for [table (slurp-many paths)]
(assoc table :db_id (:database context))))]
;; First load fields ...
(doseq [[path table-id] (map vector paths table-ids)
:when table-id]
(let [context (assoc context :table table-id)]
(load! (str path "/fields") context)))
;; ... then everything else so we don't have issues with cross-table referencess
(doseq [[path table-id] (map vector paths table-ids)
:when table-id]
(let [context (assoc context :table table-id)]
(load! (str path "/fks") context)
(load! (str path "/metrics") context)
(load! (str path "/segments") context))))) | |
(def ^:private fully-qualified-name->card-id (comp :card fully-qualified-name->context)) | |
(defn- load-fields!
[path context]
(let [fields (slurp-dir path)
field-values (map :values fields)
field-ids (maybe-upsert-many! context Field
(for [field fields]
(-> field
(update :parent_id (comp :field fully-qualified-name->context))
(update :last_analyzed u.date/parse)
(update :fk_target_field_id (comp :field fully-qualified-name->context))
(dissoc :values)
(assoc :table_id (:table context)))))]
(maybe-upsert-many! context FieldValues
(for [[field-value field-id] (map vector field-values field-ids)
:when field-id]
(assoc field-value :field_id field-id))))) | |
(defmethod load! "fields" [path context] (load-fields! path context)) | |
(defmethod load! "fks" [path context] (load-fields! path context)) | |
(defmethod load! "metrics"
[path context]
(maybe-upsert-many! context Metric
(for [metric (slurp-dir path)]
(-> metric
(assoc :table_id (:table context)
:creator_id (default-user-id))
(assoc-in [:definition :source-table] (:table context))
(update :definition mbql-fully-qualified-names->ids))))) | |
(defmethod load! "segments"
[path context]
(maybe-upsert-many! context Segment
(for [metric (slurp-dir path)]
(-> metric
(assoc :table_id (:table context)
:creator_id (default-user-id))
(assoc-in [:definition :source-table] (:table context))
(update :definition mbql-fully-qualified-names->ids))))) | |
(defn- update-card-parameter-mappings
[parameter-mappings]
(for [parameter-mapping parameter-mappings]
(-> parameter-mapping
(update-existing-capture-missing :card_id fully-qualified-name->card-id)
(update-existing-capture-missing :target mbql-fully-qualified-names->ids)))) | |
(defn- resolve-column-settings-key
[col-key]
(if-let [field-name (::mb.viz/field-str col-key)]
(let [field-id ((comp :field fully-qualified-name->context) field-name)]
(if (nil? field-id)
{::unresolved-names {field-name [::column-settings-key]}}
{::mb.viz/field-id field-id}))
col-key)) | |
(defn- resolve-param-mapping-key [k] (mbql-fully-qualified-names->ids k)) | |
(defn- resolve-dimension [dimension] (mbql-fully-qualified-names->ids dimension)) | |
(defn- resolve-param-ref [param-ref]
(cond-> param-ref
(= "dimension" (::mb.viz/param-ref-type param-ref))
(-> ; from outer cond->
(m/update-existing ::mb.viz/param-ref-id mbql-fully-qualified-names->ids)
(m/update-existing ::mb.viz/param-dimension resolve-dimension)))) | |
(defn- resolve-param-mapping-val [v]
(-> v
(m/update-existing ::mb.viz/param-mapping-id mbql-fully-qualified-names->ids)
(m/update-existing ::mb.viz/param-mapping-source resolve-param-ref)
(m/update-existing ::mb.viz/param-mapping-target resolve-param-ref))) | |
(defn- resolve-click-behavior-parameter-mapping [parameter-mapping]
(->> parameter-mapping
mb.viz/db->norm-param-mapping
(reduce-kv (fn [acc k v]
(assoc acc (resolve-param-mapping-key k)
(resolve-param-mapping-val v))) {})
mb.viz/norm->db-param-mapping)) | |
(defn- resolve-click-behavior
[click-behavior]
(-> (if-let [link-type (::mb.viz/link-type click-behavior)]
(case link-type
::mb.viz/card (let [card-id (::mb.viz/link-target-id click-behavior)]
(when (string? card-id)
(update-existing-in-capture-missing
click-behavior
[::mb.viz/link-target-id]
(comp :card fully-qualified-name->context))))
::mb.viz/dashboard (let [dashboard-id (::mb.viz/link-target-id click-behavior)]
(when (string? dashboard-id)
(update-existing-in-capture-missing
click-behavior
[::mb.viz/link-target-id]
(comp :dashboard fully-qualified-name->context))))
click-behavior)
click-behavior)
(m/update-existing ::mb.viz/parameter-mapping resolve-click-behavior-parameter-mapping))) | |
(defn- update-col-settings-click-behavior [col-settings-value]
(let [new-cb (resolve-click-behavior (::mb.viz/click-behavior col-settings-value))]
(pull-unresolved-names-up col-settings-value [::mb.viz/click-behavior] new-cb))) | |
(defn- resolve-column-settings-value
[col-value]
(cond-> col-value
(::mb.viz/click-behavior col-value) update-col-settings-click-behavior)) | |
(defn- accumulate-converted-column-settings
[acc col-key v]
(let [new-key (resolve-column-settings-key col-key)
new-val (resolve-column-settings-value v)]
(-> (pull-unresolved-names-up acc [::column-settings-key] new-key)
(dissoc ::column-settings-key)
(pull-unresolved-names-up [new-key] new-val)))) | |
(defn- resolve-top-level-click-behavior [vs-norm]
(if-let [click-behavior (::mb.viz/click-behavior vs-norm)]
(let [resolved-cb (resolve-click-behavior click-behavior)]
(pull-unresolved-names-up vs-norm [::mb.viz/click-behavior] resolved-cb))
vs-norm)) | |
Resolve the entries in a :columnsettings map (which is under a :visualizationsettings map). These map entries may contain fully qualified field names, or even other cards. In case of an unresolved name (i.e. a card that hasn't yet been loaded), we will track it under ::unresolved-names and revisit on the next pass. | (defn- resolve-column-settings
[vs-norm]
(if-let [col-settings (::mb.viz/column-settings vs-norm)]
(let [resolved-cs (reduce-kv accumulate-converted-column-settings {} col-settings)]
(pull-unresolved-names-up vs-norm [::mb.viz/column-settings] resolved-cs))
vs-norm)) |
(defn- resolve-table-column-field-ref [[f-type f-str f-md]]
(if (names/fully-qualified-field-name? f-str)
[f-type ((comp :field fully-qualified-name->context) f-str) f-md]
[f-type f-str f-md])) | |
Resolve the entries in a :pivottable.columnsplit map (which is under a :visualization_settings map). These map entries may contain fully qualified field names, or even other cards. In case of an unresolved name (i.e. a card that hasn't yet been loaded), we will track it under ::unresolved-names and revisit on the next pass. | (defn- resolve-pivot-table-settings
[vs-norm]
(if (:pivot_table.column_split vs-norm)
(letfn [(resolve-vec [pivot vec-type]
(update-in pivot [:pivot_table.column_split vec-type] (fn [tbl-vecs]
(mapv resolve-table-column-field-ref tbl-vecs))))]
(-> vs-norm
(resolve-vec :rows)
(resolve-vec :columns)))
vs-norm)) |
Resolve the :table.columns key from a :visualization_settings map, which may contain fully qualified field names. Such fully qualified names will be converted to the numeric field ID before being filled into the loaded card. Only other field names (not cards, or other collection based entity types) should be referenced here, so there is no need to detect or track ::unresolved-names. | (defn- resolve-table-columns
[vs-norm]
(if (::mb.viz/table-columns vs-norm)
(letfn [(resolve-field-id [tbl-col]
(update tbl-col ::mb.viz/table-column-field-ref resolve-table-column-field-ref))]
(update vs-norm ::mb.viz/table-columns (fn [tbl-cols]
(mapv resolve-field-id tbl-cols))))
vs-norm)) |
Resolve all references from a :visualization_settings map, the various submaps of which may contain: - fully qualified field names - fully qualified card or dashboard names Any unresolved entities from this resolution process will be tracked via ::unresolved-named so that the card or dashboard card holding these visualization settings can be revisited in a future pass. | (defn- resolve-visualization-settings
[entity]
(if-let [viz-settings (:visualization_settings entity)]
(let [resolved-vs (-> (mb.viz/db->norm viz-settings)
resolve-top-level-click-behavior
resolve-column-settings
resolve-table-columns
resolve-pivot-table-settings
mb.viz/norm->db)]
(pull-unresolved-names-up entity [:visualization_settings] resolved-vs))
entity)) |
(defn- resolve-dashboard-parameters
[parameters]
(for [p parameters]
;; Note: not using the full ::unresolved-names functionality here because this is a fix
;; for a deprecated feature
(m/update-existing-in p [:values_source_config :card_id] fully-qualified-name->card-id))) | |
Loads | (defn load-dashboards!
{:added "0.40.0"}
[context dashboards]
(let [dashboard-ids (maybe-upsert-many! context Dashboard
(for [dashboard dashboards]
(-> dashboard
(update :parameters resolve-dashboard-parameters)
(dissoc :dashboard_cards)
(assoc :collection_id (:collection context)
:creator_id (default-user-id)))))
;; MEGA HACK -- if `load` is ran with `--mode update` we should delete any Cards that were removed from a
;; Dashboard (according to #20786). However there are literally zero facilities for doing this sort of thing in
;; the current dump/load codebase. So for now we'll just delete ALL DashboardCards for the dumped Dashboard when
;; running with `--mode update` and recreate them from the serialized definitions. This is definitely a wack way
;; of doing things but no one actually understands how this code is supposed to work so this will have to do
;; until we can come in here and clean things up. -- Cam 2022-03-24
_ (when (and (= (:mode context) :update)
(seq dashboard-ids))
(t2/delete! DashboardCard :dashboard_id [:in (set dashboard-ids)]))
dashboard-cards (map :dashboard_cards dashboards)
;; a function that prepares a dash card for insertion, while also validating to ensure the underlying
;; card_id could be resolved from the fully qualified name
prepare-card-fn (fn [dash-idx dashboard-id acc card-idx card]
(let [proc-card (-> card
(update-existing-capture-missing :card_id fully-qualified-name->card-id)
(assoc :dashboard_id dashboard-id))
new-pm (update-card-parameter-mappings (:parameter_mappings proc-card))
with-pm (pull-unresolved-names-up proc-card [:parameter_mappings] new-pm)
with-viz (resolve-visualization-settings with-pm)]
(if-let [unresolved (::unresolved-names with-viz)]
;; prepend the dashboard card index and :visualization_settings to each unresolved
;; name path for better debugging
(let [add-keys [:dashboard_cards card-idx :visualization_settings]
fixed-names (m/map-vals #(concat add-keys %) unresolved)
with-fixed-names (assoc with-viz ::unresolved-names fixed-names)]
(-> acc
(update ::revisit (fn [revisit-map]
(update revisit-map dash-idx #(cons with-fixed-names %))))
;; index means something different here than in the Card case (it's actually the index
;; of the dashboard)
(update ::revisit-index #(conj % dash-idx))))
(update acc ::process #(conj % with-viz)))))
prep-init-acc {::process [] ::revisit-index #{} ::revisit {}}
filtered-cards (reduce-kv
(fn [acc idx [cards dash-id]]
(if dash-id
(let [res (reduce-kv (partial prepare-card-fn idx dash-id) prep-init-acc (vec cards))]
(merge-with concat acc res))
acc))
prep-init-acc
(mapv vector dashboard-cards dashboard-ids))
revisit-indexes (vec (::revisit-index filtered-cards))
proceed-cards (vec (::process filtered-cards))
dashcard-ids (maybe-upsert-many! context DashboardCard (map #(dissoc % :series) proceed-cards))
series-pairs (map vector (map :series proceed-cards) dashcard-ids)]
(maybe-upsert-many! context DashboardCardSeries
(for [[series dashboard-card-id] series-pairs
dashboard-card-series series
:when (and dashboard-card-series dashboard-card-id)]
(-> dashboard-card-series
(assoc :dashboardcard_id dashboard-card-id)
(update :card_id fully-qualified-name->card-id))))
(let [revisit-dashboards (map (partial nth dashboards) revisit-indexes)]
(when (seq revisit-dashboards)
(let [revisit-map (::revisit filtered-cards)
revisit-inf-fn (fn [[dash-idx dashcards]]
(format
"For dashboard %s:%n%s"
(->> dash-idx (nth dashboards) :name)
(str/join "\n" (map unresolved-names->string dashcards))))]
(log/infof
"Unresolved references found for dashboard cards in collection %d; will reload after first pass%n%s%n"
(:collection context)
(str/join "\n" (map revisit-inf-fn revisit-map)))
(fn []
(log/infof
"Retrying dashboards for collection %s: %s"
(or (:collection context) "root")
(str/join ", " (map :name revisit-dashboards)))
(load-dashboards! (assoc context :mode :update) revisit-dashboards))))))) |
(defmethod load! "dashboards"
[path context]
(binding [names/*suppress-log-name-lookup-exception* true]
(load-dashboards! context (slurp-dir path)))) | |
(defn- load-pulses! [pulses context]
(let [cards (map :cards pulses)
channels (map :channels pulses)
pulse-ids (maybe-upsert-many! context Pulse
(for [pulse pulses]
(-> pulse
(assoc :collection_id (:collection context)
:creator_id (default-user-id))
(dissoc :channels :cards))))
pulse-cards (for [[cards pulse-id pulse-idx] (map vector cards pulse-ids (range 0 (count pulse-ids)))
card cards
:when pulse-id]
(-> card
(assoc :pulse_id pulse-id)
;; gather the pulse's name and index for easier bookkeeping later
(assoc ::pulse-index pulse-idx)
(assoc ::pulse-name (:name (nth pulses pulse-idx)))
(update-in-capture-missing [:card_id] fully-qualified-name->card-id)))
grouped (group-by #(empty? (::unresolved-names %)) pulse-cards)
process (get grouped true)
revisit (get grouped false)]
(maybe-upsert-many! context PulseCard (map #(dissoc % ::pulse-index ::pulse-name) process))
(maybe-upsert-many! context PulseChannel
(for [[channels pulse-id] (map vector channels pulse-ids)
channel channels
:when pulse-id]
(assoc channel :pulse_id pulse-id)))
(when (seq revisit)
(let [revisit-info-map (group-by ::pulse-name revisit)]
(log/infof "Unresolved references for pulses in collection %s; will reload after first pass complete:%n%s%n"
(or (:collection context) "root")
(str/join "\n" (map
(fn [[pulse-name revisit-cards]]
(format " for %s:%n%s"
pulse-name
(str/join "\n" (map (comp unresolved-names->string #(into {} %)) revisit-cards))))
revisit-info-map)))
(fn []
(log/infof "Reloading pulses from collection %d" (:collection context))
(let [pulse-indexes (map ::pulse-index revisit)]
(load-pulses! (map (partial nth pulses) pulse-indexes) (assoc context :mode :update)))))))) | |
(defmethod load! "pulses"
[path context]
(binding [names/*suppress-log-name-lookup-exception* true]
(load-pulses! (slurp-dir path) context))) | |
(defn- resolve-source-query [query]
(if (:source-query query)
(update-in-capture-missing query [:source-query] resolve-source-query)
query)) | |
(defn- source-card
[fully-qualified-name]
(try
(-> (fully-qualified-name->context fully-qualified-name) :card)
(catch Throwable e
(log/warn e (trs "Could not find context for fully qualified card name {0}" fully-qualified-name))))) | |
(defn- resolve-snippet
[fully-qualified-name]
(try
(-> (fully-qualified-name->context fully-qualified-name) :snippet)
(catch Throwable e
(log/debug e (trs "Could not find context for fully qualified snippet name {0}" fully-qualified-name))))) | |
(defn- resolve-native
[card]
(let [ks [:dataset_query :native :template-tags]
template-tags (get-in card ks)
new-template-tags (reduce-kv
(fn [m k v]
(let [new-v (-> (update-existing-capture-missing v :card-id source-card)
(update-existing-capture-missing :snippet-id resolve-snippet))]
(pull-unresolved-names-up m [k] new-v)))
{}
template-tags)]
(pull-unresolved-names-up card ks new-template-tags))) | |
(defn- resolve-card-dataset-query [card]
(let [ks [:dataset_query :query]
new-q (update-in-capture-missing card ks resolve-source-query)]
(-> (pull-unresolved-names-up card ks (get-in new-q ks))
(gather-all-unresolved-names)))) | |
(defn- resolve-card [card context]
(-> card
(update :table_id (comp :table fully-qualified-name->context))
(update :database_id (comp :database fully-qualified-name->context))
(update :dataset_query mbql-fully-qualified-names->ids)
(assoc :creator_id (default-user-id)
:collection_id (:collection context))
(update-in [:dataset_query :database] (comp :database fully-qualified-name->context))
resolve-visualization-settings
(cond->
(-> card
:dataset_query
:type
mbql.u/normalize-token
(= :query)) resolve-card-dataset-query
(-> card
:dataset_query
:native
:template-tags
not-empty) (resolve-native)))) | |
Make a dummy card for first pass insertion | (defn- make-dummy-card
[card]
(-> card
(assoc :dataset_query {:type :native
:native {:query "-- DUMMY QUERY FOR SERIALIZATION FIRST PASS INSERT"}
:database (:database_id card)})
(dissoc ::unresolved-names))) |
Loads cards in a given | (defn load-cards!
{:added "0.40.0"}
[context paths only-cards]
(let [cards (or only-cards (slurp-many paths))
resolved-cards (for [card cards]
(resolve-card card context))
grouped-cards (reduce-kv
(fn [acc idx card]
(if (::unresolved-names card)
(-> acc
(update ::revisit #(conj % card))
(update ::revisit-index #(conj % idx)))
(update acc ::process #(conj % card))))
{::revisit [] ::revisit-index #{} ::process []}
(vec resolved-cards))
dummy-insert-cards (not-empty (::revisit grouped-cards))
process-cards (::process grouped-cards)]
(maybe-upsert-many! context Card process-cards)
(when dummy-insert-cards
(let [dummy-inserted-ids (maybe-upsert-many!
context
Card
(map make-dummy-card dummy-insert-cards))
id-and-cards (map vector dummy-insert-cards dummy-inserted-ids)
retry-info-fn (fn [[card card-id]]
(unresolved-names->string card card-id))]
(log/infof
"Unresolved references found for cards in collection %d; will reload after first pass%n%s%n"
(:collection context)
(str/join "\n" (map retry-info-fn id-and-cards)))
(fn []
(log/infof "Attempting to reload cards in collection %d" (:collection context))
(let [revisit-indexes (::revisit-index grouped-cards)]
(load-cards! (assoc context :mode :update) paths (mapv (partial nth cards) revisit-indexes)))))))) |
(defmethod load! "cards"
[path context]
(binding [names/*suppress-log-name-lookup-exception* true]
(load-cards! context (list-dirs path) nil))) | |
A function called on each User instance before it is inserted (via upsert). | (defn- pre-insert-user [user] (log/infof "User with email %s is new to target DB; setting a random password" (:email user)) (assoc user :password (str (random-uuid)))) |
leaving comment out for now (deliberately), because this will send a password reset email to newly inserted users
when enabled in a future release; see | #_(defn- post-insert-user
"A function called on the ID of each `User` instance after it is inserted (via upsert)."
[user-id]
(when-let [{email :email, google-auth? :google_auth, is-active? :is_active}
(t2/select-one [User :email :google_auth :is_active] :id user-id)]
(let [reset-token (user/set-password-reset-token! user-id)
site-url (public-settings/site-url)
password-reset-url (str site-url "/auth/reset_password/" reset-token)
;; in a web server context, the server-name ultimately comes from ServletRequest/getServerName
;; (i.e. the Java class, via Ring); this is the closest approximation in our batch context
server-name (.getHost (URL. site-url))]
(let [email-res (email/send-password-reset-email! email google-auth? server-name password-reset-url is-active?)]
(if (:error email-res)
(log/infof "Failed to send password reset email generated for user ID %d (%s): %s"
user-id
email
(:message email-res))
(log/infof "Password reset email generated for user ID %d (%s)" user-id email)))
user-id)))
(defmethod load! "users"
[path context]
;; Currently we only serialize the new owner user, so it's fine to ignore mode setting
;; add :post-insert-fn post-insert-user back to start sending password reset emails
(maybe-upsert-many! (assoc context :pre-insert-fn pre-insert-user) User
(for [user (slurp-dir path)]
(dissoc user :password)))) |
(defn- derive-location
[context]
(if-let [parent-id (:collection context)]
(str (t2/select-one-fn :location Collection :id parent-id) parent-id "/")
"/")) | |
(defn- make-reload-fn [all-results]
(let [all-fns (filter fn? all-results)]
(when (seq all-fns)
(let [new-fns (doall all-fns)]
(fn []
(make-reload-fn (for [reload-fn new-fns]
(reload-fn)))))))) | |
(defn- load-collections!
[path context]
(let [subdirs (list-dirs path)
by-ns (group-by #(let [[_ coll-ns] (re-matches #".*/:([^:/]+)" %)]
coll-ns)
subdirs)
grouped (group-by (comp nil? first) by-ns)
ns-paths (get grouped false)
entity-paths (->> (get grouped true)
(map last)
first)
results (for [path entity-paths]
(let [context (assoc context
:collection (->> (slurp-dir path)
(map #(assoc % :location (derive-location context)
:namespace (-> context
:collection-namespace)))
(maybe-upsert-many! context Collection)
first))]
(log/infof "Processing collection at path %s" path)
[(load! (str path "/collections") context)
(load! (str path "/cards") context)
(load! (str path "/pulses") context)
(load! (str path "/dashboards") context)
(load! (str path "/snippets") context)]))
load-ns-fns (for [[coll-ns [coll-ns-path]] ns-paths]
(do (log/infof "Loading %s namespace for collection at path %s" coll-ns coll-ns-path)
(load-collections! coll-ns-path (assoc context :collection-namespace coll-ns))))]
(make-reload-fn (concat (apply concat results) ; these are each sequences, so need to flatten those first
load-ns-fns)))) | |
(defmethod load! "collections" [path context] (load-collections! path context)) | |
(defn- prepare-snippet [context snippet]
(assoc snippet :creator_id (default-user-id)
:collection_id (:collection context))) | |
(defmethod load! "snippets"
[path context]
(let [paths (list-dirs path)
snippets (map (partial prepare-snippet context) (slurp-many paths))]
(maybe-upsert-many! context NativeQuerySnippet snippets))) | |
Load a dump of settings. | (defn load-settings!
[path context]
(doseq [[k v] (yaml/from-file (str path "/settings.yaml"))
:when (or (= context :update)
(nil? (setting/get-value-of-type :string k)))]
(setting/set-value-of-type! :string k v))) |
Is dump at path | (defn compatible?
[path]
(-> (str path "/manifest.yaml")
yaml/from-file
:metabase-version
(= config/mb-version-info))) |
Consistent instance-independent naming scheme that replaces IDs with human-readable paths. | (ns metabase-enterprise.serialization.names (:require [clojure.string :as str] [malli.core :as mc] [metabase.db.connection :as mdb.connection] [metabase.lib.schema.id :as lib.schema.id] [metabase.models.card :refer [Card]] [metabase.models.collection :refer [Collection]] [metabase.models.dashboard :refer [Dashboard]] [metabase.models.database :as database :refer [Database]] [metabase.models.field :refer [Field]] [metabase.models.interface :as mi] [metabase.models.metric :refer [Metric]] [metabase.models.native-query-snippet :refer [NativeQuerySnippet]] [metabase.models.pulse :refer [Pulse]] [metabase.models.segment :refer [Segment]] [metabase.models.table :refer [Table]] [metabase.models.user :refer [User]] [metabase.util.i18n :as i18n :refer [trs]] [metabase.util.log :as log] [metabase.util.malli.schema :as ms] [ring.util.codec :as codec] [toucan2.core :as t2] [toucan2.protocols :as t2.protocols])) |
(set! *warn-on-reflection* true) | |
(def ^:private root-collection-path "/collections/root") | |
Return entity name URL encoded except that spaces are retained. | (defn safe-name [entity] (some-> entity ((some-fn :email :name)) codec/url-encode (str/replace "%20" " "))) |
Inverse of | (def unescape-name codec/url-decode) |
(defmulti ^:private fully-qualified-name* mi/model) | |
Get the logical path for entity | (def ^{:arglists '([entity] [model id])} fully-qualified-name
(mdb.connection/memoize-for-application-db
(fn
([entity] (fully-qualified-name* entity))
([model id]
(if (string? id)
id
(fully-qualified-name* (t2/select-one model :id id))))))) |
(defmethod fully-qualified-name* Database [db] (str "/databases/" (safe-name db))) | |
(defmethod fully-qualified-name* Table
[table]
(if (:schema table)
(format "%s/schemas/%s/tables/%s"
(->> table :db_id (fully-qualified-name Database))
(:schema table)
(safe-name table))
(format "%s/tables/%s"
(->> table :db_id (fully-qualified-name Database))
(safe-name table)))) | |
(defmethod fully-qualified-name* Field
[field]
(if (:fk_target_field_id field)
(str (->> field :table_id (fully-qualified-name Table)) "/fks/" (safe-name field))
(str (->> field :table_id (fully-qualified-name Table)) "/fields/" (safe-name field)))) | |
(defmethod fully-qualified-name* Metric [metric] (str (->> metric :table_id (fully-qualified-name Table)) "/metrics/" (safe-name metric))) | |
(defmethod fully-qualified-name* Segment [segment] (str (->> segment :table_id (fully-qualified-name Table)) "/segments/" (safe-name segment))) | |
(defn- local-collection-name [collection]
(let [ns-part (when-let [coll-ns (:namespace collection)]
(str ":" (if (keyword? coll-ns) (name coll-ns) coll-ns) "/"))]
(str "/collections/" ns-part (safe-name collection)))) | |
(defmethod fully-qualified-name* Collection
[collection]
(let [parents (some->> (str/split (:location collection) #"/")
rest
not-empty
(map #(local-collection-name (t2/select-one Collection :id (Integer/parseInt %))))
(apply str))]
(str root-collection-path parents (local-collection-name collection)))) | |
(defmethod fully-qualified-name* Dashboard
[dashboard]
(format "%s/dashboards/%s"
(or (some->> dashboard :collection_id (fully-qualified-name Collection))
root-collection-path)
(safe-name dashboard))) | |
(defmethod fully-qualified-name* Pulse
[pulse]
(format "%s/pulses/%s"
(or (some->> pulse :collection_id (fully-qualified-name Collection))
root-collection-path)
(safe-name pulse))) | |
(defmethod fully-qualified-name* Card
[card]
(format "%s/cards/%s"
(or (some->> card
:collection_id
(fully-qualified-name Collection))
root-collection-path)
(safe-name card))) | |
(defmethod fully-qualified-name* User [user] (str "/users/" (:email user))) | |
(defmethod fully-qualified-name* NativeQuerySnippet
[snippet]
(format "%s/snippets/%s"
(or (some->> snippet :collection_id (fully-qualified-name Collection))
root-collection-path)
(safe-name snippet))) | |
(defmethod fully-qualified-name* nil [_] nil) | |
All the references in the dumps should resolved to entities already loaded. | (def ^:private Context
[:map {:closed true}
[:database {:optional true} ms/PositiveInt]
[:table {:optional true} ms/PositiveInt]
[:schema {:optional true} [:maybe :string]]
[:field {:optional true} ms/PositiveInt]
[:metric {:optional true} ms/PositiveInt]
[:segment {:optional true} ms/PositiveInt]
[:card {:optional true} ms/PositiveInt]
[:dashboard {:optional true} ms/PositiveInt]
[:collection {:optional true} [:maybe ms/PositiveInt]] ; root collection
[:pulse {:optional true} ms/PositiveInt]
[:user {:optional true} ms/PositiveInt]
[:snippet {:optional true} [:maybe ms/PositiveInt]]]) |
(defmulti ^:private path->context* (fn [_ model _ _]
model)) | |
Extract entities from a logical path. | (def ^:private ^{:arglists '([context model model-attrs entity-name])} path->context
path->context*) |
(defmethod path->context* "databases"
[context _ _ db-name]
(assoc context :database (if (= db-name "__virtual")
lib.schema.id/saved-questions-virtual-database-id
(t2/select-one-pk Database :name db-name)))) | |
(defmethod path->context* "schemas" [context _ _ schema] (assoc context :schema schema)) | |
(defmethod path->context* "tables"
[context _ _ table-name]
(assoc context :table (t2/select-one-pk Table
:db_id (:database context)
:schema (:schema context)
:name table-name))) | |
(defmethod path->context* "fields"
[context _ _ field-name]
(assoc context :field (t2/select-one-pk Field
:table_id (:table context)
:name field-name))) | |
(defmethod path->context* "fks" [context _ _ field-name] (path->context* context "fields" nil field-name)) | |
(defmethod path->context* "metrics"
[context _ _ metric-name]
(assoc context :metric (t2/select-one-pk Metric
:table_id (:table context)
:name metric-name))) | |
(defmethod path->context* "segments"
[context _ _ segment-name]
(assoc context :segment (t2/select-one-pk Segment
:table_id (:table context)
:name segment-name))) | |
(defmethod path->context* "collections"
[context _ model-attrs collection-name]
(if (= collection-name "root")
(assoc context :collection nil)
(assoc context :collection (t2/select-one-pk Collection
:name collection-name
:namespace (:namespace model-attrs)
:location (or (letfn [(collection-location [id]
(t2/select-one-fn :location Collection :id id))]
(some-> context
:collection
collection-location
(str (:collection context) "/")))
"/"))))) | |
(defmethod path->context* "dashboards"
[context _ _ dashboard-name]
(assoc context :dashboard (t2/select-one-pk Dashboard
:collection_id (:collection context)
:name dashboard-name))) | |
(defmethod path->context* "pulses"
[context _ _ pulse-name]
(assoc context :dashboard (t2/select-one-pk Pulse
:collection_id (:collection context)
:name pulse-name))) | |
(defmethod path->context* "cards"
[context _ _ dashboard-name]
(assoc context :card (t2/select-one-pk Card
:collection_id (:collection context)
:name dashboard-name))) | |
(defmethod path->context* "users"
[context _ _ email]
(assoc context :user (t2/select-one-pk User
:email email))) | |
(defmethod path->context* "snippets"
[context _ _ snippet-name]
(assoc context :snippet (t2/select-one-pk NativeQuerySnippet
:collection_id (:collection context)
:name snippet-name))) | |
(def ^:private separator-pattern #"\/") | |
Dynamic boolean var that controls whether warning messages will NOT be logged on a failed name lookup (from within
| (def ^:dynamic *suppress-log-name-lookup-exception* false) |
Returns true if the given | (defn fully-qualified-field-name?
[field-name]
(and (some? field-name)
(str/starts-with? field-name "/databases/")
(or (str/includes? field-name "/fks/") (str/includes? field-name "/fields/")))) |
Returns true if the given | (defn fully-qualified-table-name?
[table-name]
(and (some? table-name)
(string? table-name)
(str/starts-with? table-name "/databases/")
(not (str/starts-with? table-name "card__")))) |
Returns true if the given | (defn fully-qualified-card-name?
[card-name]
(and (some? card-name)
(string? card-name)
(str/starts-with? card-name "/collections/root/")
(str/includes? card-name "/cards/"))) |
WARNING: THIS MUST APPEAR AFTER ALL path->context* IMPLEMENTATIONS | (def ^:private all-entities (-> path->context*
methods
keys
set)) |
This is more complicated than it needs to be due to potential clashes between an entity name (ex: a table called
"users" and a model name (ex: "users"). Could fix in a number of ways, including special prefix of model names,
but that would require changing the format and updating all the | (defn- partition-name-components
([name-comps]
(partition-name-components {::name-components [] ::current-component []} name-comps))
([acc [c & more-comps]]
(cond
(nil? more-comps)
(conj (::name-components acc) (conj (::current-component acc) c))
(::prev-model-name? acc)
(if (= \: (first c))
(partition-name-components (update acc ::current-component conj c) more-comps)
(partition-name-components (-> (assoc acc ::prev-model-name? false)
(update ::current-component
conj
c))
more-comps))
(contains? all-entities c)
(partition-name-components (cond-> (assoc acc ::prev-model-name? true
::current-component [c])
(not-empty (::current-component acc))
(update ::name-components conj (::current-component acc)))
more-comps)))) |
Parse a logical path into a context map. | (defn fully-qualified-name->context
[fully-qualified-name]
(when fully-qualified-name
(let [components (->> (str/split fully-qualified-name separator-pattern)
rest ; we start with a /
partition-name-components
(map (fn [[model-name & entity-parts]]
(cond-> {::model-name model-name ::entity-name (last entity-parts)}
(and (= "collections" model-name) (> (count entity-parts) 1))
(assoc :namespace (->> entity-parts
first ; ns is first/only item after "collections"
rest ; strip the starting :
(apply str)))))))
context (loop [acc-context {}
[{::keys [model-name entity-name] :as model-map} & more] components]
(let [model-attrs (dissoc model-map ::model-name ::entity-name)
new-context (path->context acc-context model-name model-attrs (unescape-name entity-name))]
(if (empty? more)
new-context
(recur new-context more))))]
(if (and
(not (mc/validate [:maybe Context] context))
(not *suppress-log-name-lookup-exception*))
(log/warn
(ex-info (trs "Can''t resolve {0} in fully qualified name {1}"
(str/join ", " (map name (keys context)))
fully-qualified-name)
{:fully-qualified-name fully-qualified-name
:resolve-name-failed? true
:context context}))
context)))) |
Return a string representation of entity suitable for logs | (defn name-for-logging
([entity] (name-for-logging (t2.protocols/model entity) entity))
([model {:keys [name id]}]
(cond
(and name id) (format "%s \"%s\" (ID %s)" model name id)
name (format "%s \"%s\"" model name)
id (format "%s %s" model id)
:else model))) |
Transform entity into a form suitable for serialization. | (ns metabase-enterprise.serialization.serialize (:require [clojure.string :as str] [medley.core :as m] [metabase-enterprise.serialization.names :refer [fully-qualified-name]] [metabase.lib.schema.id :as lib.schema.id] [metabase.mbql.normalize :as mbql.normalize] [metabase.mbql.util :as mbql.u] [metabase.models.card :refer [Card]] [metabase.models.dashboard :refer [Dashboard]] [metabase.models.dashboard-card :refer [DashboardCard]] [metabase.models.dashboard-card-series :refer [DashboardCardSeries]] [metabase.models.database :as database :refer [Database]] [metabase.models.dimension :refer [Dimension]] [metabase.models.field :as field :refer [Field]] [metabase.models.interface :as mi] [metabase.models.metric :refer [Metric]] [metabase.models.native-query-snippet :refer [NativeQuerySnippet]] [metabase.models.pulse :refer [Pulse]] [metabase.models.pulse-card :refer [PulseCard]] [metabase.models.pulse-channel :refer [PulseChannel]] [metabase.models.segment :refer [Segment]] [metabase.models.table :refer [Table]] [metabase.models.user :refer [User]] [metabase.shared.models.visualization-settings :as mb.viz] [metabase.util :as u] [toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
Current serialization protocol version. This gets stored with each dump, so we can correctly recover old dumps. | (def ^:const ^Long serialization-protocol-version ;; version 2 - start adding namespace portion to /collections/ paths 2) |
Is given form an MBQL entity reference? | (def ^:private ^{:arglists '([form])} mbql-entity-reference?
(partial mbql.normalize/is-clause? #{:field :field-id :fk-> :metric :segment})) |
(defn- mbql-id->fully-qualified-name
[mbql]
(-> mbql
mbql.normalize/normalize-tokens
(mbql.u/replace
;; `integer?` guard is here to make the operation idempotent
[:field (id :guard integer?) opts]
[:field (fully-qualified-name Field id) (mbql-id->fully-qualified-name opts)]
;; field-id is still used within parameter mapping dimensions
;; example relevant clause - [:dimension [:fk-> [:field-id 1] [:field-id 2]]]
[:field-id (id :guard integer?)]
[:field-id (fully-qualified-name Field id)]
;; source-field is also used within parameter mapping dimensions
;; example relevant clause - [:field 2 {:source-field 1}]
{:source-field (id :guard integer?)}
(assoc &match :source-field (fully-qualified-name Field id))
[:metric (id :guard integer?)]
[:metric (fully-qualified-name Metric id)]
[:segment (id :guard integer?)]
[:segment (fully-qualified-name Segment id)]))) | |
(defn- ids->fully-qualified-names
[entity]
(mbql.u/replace entity
mbql-entity-reference?
(mbql-id->fully-qualified-name &match)
map?
(as-> &match entity
(m/update-existing entity :database (fn [db-id]
(if (= db-id lib.schema.id/saved-questions-virtual-database-id)
"database/__virtual"
(fully-qualified-name Database db-id))))
(m/update-existing entity :card_id (partial fully-qualified-name Card)) ; attibutes that refer to db fields use _
(m/update-existing entity :card-id (partial fully-qualified-name Card)) ; template-tags use dash
(m/update-existing entity :source-table (fn [source-table]
(if (and (string? source-table)
(str/starts-with? source-table "card__"))
(fully-qualified-name Card (-> source-table
(str/split #"__")
second
Integer/parseInt))
(fully-qualified-name Table source-table))))
(m/update-existing entity :breakout (fn [breakout]
(map mbql-id->fully-qualified-name breakout)))
(m/update-existing entity :aggregation (fn [aggregation]
(m/map-vals mbql-id->fully-qualified-name aggregation)))
(m/update-existing entity :filter (fn [filter]
(m/map-vals mbql-id->fully-qualified-name filter)))
(m/update-existing entity ::mb.viz/param-mapping-source (partial fully-qualified-name Field))
(m/update-existing entity :snippet-id (partial fully-qualified-name NativeQuerySnippet))
(m/map-vals ids->fully-qualified-names entity)))) | |
Removes unneeded fields that can either be reconstructed from context or are meaningless (eg. :created_at). | (defn- strip-crud
[entity]
(cond-> (dissoc entity :id :creator_id :created_at :updated_at :db_id :location
:dashboard_id :fields_hash :personal_owner_id :made_public_by_id :collection_id
:pulse_id :result_metadata :entity_id :action_id)
(some #(instance? % entity) (map type [Metric Field Segment])) (dissoc :table_id))) |
(defmulti ^:private serialize-one
{:arglists '([instance])}
mi/model) | |
Serialize entity | (def ^{:arglists '([entity])} serialize
(comp ids->fully-qualified-names strip-crud serialize-one)) |
(defmethod serialize-one :default [instance] instance) | |
(defmethod serialize-one Database [db] (dissoc db :features)) | |
(defmethod serialize-one Field
[field]
(let [field (-> field
(update :parent_id (partial fully-qualified-name Field))
(update :fk_target_field_id (partial fully-qualified-name Field)))]
(if (contains? field :values)
(update field :values u/select-non-nil-keys [:values :human_readable_values])
(assoc field :values (-> field
field/values
(u/select-non-nil-keys [:values :human_readable_values])))))) | |
(defn- convert-column-settings-key [k]
(if-let [field-id (::mb.viz/field-id k)]
(-> (t2/select-one Field :id field-id)
fully-qualified-name
mb.viz/field-str->column-ref)
k)) | |
The | (defn- convert-param-mapping-key [k] (mbql-id->fully-qualified-name k)) |
(defn- convert-param-ref [new-id param-ref]
(cond-> param-ref
(= "dimension" (::mb.viz/param-ref-type param-ref)) ids->fully-qualified-names
(some? new-id) (update ::mb.viz/param-ref-id new-id))) | |
(defn- convert-param-mapping-val [new-id v]
(-> v
(m/update-existing ::mb.viz/param-mapping-source (partial convert-param-ref new-id))
(m/update-existing ::mb.viz/param-mapping-target (partial convert-param-ref new-id))
(m/assoc-some ::mb.viz/param-mapping-id (or new-id (::mb.viz/param-mapping-id v))))) | |
(defn- convert-parameter-mapping [param-mapping]
(if (nil? param-mapping)
nil
(reduce-kv (fn [acc k v]
(assoc acc (convert-param-mapping-key k)
(convert-param-mapping-val nil v))) {} param-mapping))) | |
(defn- convert-click-behavior [{:keys [::mb.viz/link-type ::mb.viz/link-target-id] :as click}]
(-> (if-let [new-target-id (case link-type
::mb.viz/card (-> (t2/select-one Card :id link-target-id)
fully-qualified-name)
::mb.viz/dashboard (-> (t2/select-one Dashboard :id link-target-id)
fully-qualified-name)
nil)]
(assoc click ::mb.viz/link-target-id new-target-id)
click)
(m/update-existing ::mb.viz/parameter-mapping convert-parameter-mapping))) | |
(defn- convert-column-settings-value [{:keys [::mb.viz/click-behavior] :as v}]
(cond (not-empty click-behavior) (assoc v ::mb.viz/click-behavior (convert-click-behavior click-behavior))
:else v)) | |
(defn- convert-column-settings [acc k v] (assoc acc (convert-column-settings-key k) (convert-column-settings-value v))) | |
(defn- convert-viz-settings [viz-settings]
(-> (mb.viz/db->norm viz-settings)
(m/update-existing ::mb.viz/column-settings (fn [col-settings]
(reduce-kv convert-column-settings {} col-settings)))
(m/update-existing ::mb.viz/click-behavior convert-click-behavior)
mb.viz/norm->db)) | |
(defn- dashboard-cards-for-dashboard
[dashboard]
(let [dashboard-cards (t2/select DashboardCard :dashboard_id (u/the-id dashboard))
series (when (not-empty dashboard-cards)
(t2/select DashboardCardSeries
:dashboardcard_id [:in (map u/the-id dashboard-cards)]))]
(for [dashboard-card dashboard-cards]
(-> dashboard-card
(assoc :series (for [series series
:when (= (:dashboardcard_id series) (u/the-id dashboard-card))]
(-> series
(update :card_id (partial fully-qualified-name Card))
(dissoc :id :dashboardcard_id))))
(assoc :visualization_settings (convert-viz-settings (:visualization_settings dashboard-card)))
strip-crud)))) | |
(defmethod serialize-one Dashboard [dashboard] (assoc dashboard :dashboard_cards (dashboard-cards-for-dashboard dashboard))) | |
(defmethod serialize-one Card
[card]
(-> card
(m/update-existing :table_id (partial fully-qualified-name Table))
(update :database_id (partial fully-qualified-name Database))
(m/update-existing :visualization_settings convert-viz-settings))) | |
(defmethod serialize-one Pulse
[pulse]
(assoc pulse
:cards (for [card (t2/select PulseCard :pulse_id (u/the-id pulse))]
(-> card
(dissoc :id :pulse_id)
(update :card_id (partial fully-qualified-name Card))))
:channels (for [channel (t2/select PulseChannel :pulse_id (u/the-id pulse))]
(strip-crud channel)))) | |
(defmethod serialize-one User [user] (select-keys user [:first_name :last_name :email :is_superuser])) | |
(defmethod serialize-one Dimension
[dimension]
(-> dimension
(update :field_id (partial fully-qualified-name Field))
(update :human_readable_field_id (partial fully-qualified-name Field)))) | |
(defmethod serialize-one NativeQuerySnippet [snippet] (select-keys snippet [:name :description :content])) | |
Upsert-or-skip functionality for our models. | (ns metabase-enterprise.serialization.upsert (:require [cheshire.core :as json] [clojure.data :as data] [medley.core :as m] [metabase-enterprise.serialization.names :refer [name-for-logging]] [metabase.models.card :refer [Card]] [metabase.models.collection :refer [Collection]] [metabase.models.dashboard :refer [Dashboard]] [metabase.models.dashboard-card :refer [DashboardCard]] [metabase.models.dashboard-card-series :refer [DashboardCardSeries]] [metabase.models.database :as database :refer [Database]] [metabase.models.dimension :refer [Dimension]] [metabase.models.field :refer [Field]] [metabase.models.field-values :refer [FieldValues]] [metabase.models.metric :refer [Metric]] [metabase.models.native-query-snippet :refer [NativeQuerySnippet]] [metabase.models.pulse :refer [Pulse]] [metabase.models.pulse-card :refer [PulseCard]] [metabase.models.pulse-channel :refer [PulseChannel]] [metabase.models.segment :refer [Segment]] [metabase.models.setting :as setting :refer [Setting]] [metabase.models.table :refer [Table]] [metabase.models.user :refer [User]] [metabase.util :as u] [metabase.util.i18n :as i18n :refer [trs]] [metabase.util.log :as log] [methodical.core :as methodical] [toucan2.core :as t2] [toucan2.tools.after :as t2.after])) |
(def ^:private identity-condition
{Database [:name :engine]
Table [:schema :name :db_id]
Field [:name :table_id]
Metric [:name :table_id]
Segment [:name :table_id]
Collection [:name :location :namespace]
Dashboard [:name :collection_id]
DashboardCard [:card_id :dashboard_id :visualization_settings]
DashboardCardSeries [:dashboardcard_id :card_id]
FieldValues [:field_id]
Dimension [:field_id :human_readable_field_id]
Setting [:key]
Pulse [:name :collection_id]
PulseCard [:pulse_id :card_id]
PulseChannel [:pulse_id :channel_type :details]
Card [:name :collection_id]
User [:email]
NativeQuerySnippet [:name :collection_id]}) | |
This could potentially be unrolled into one giant select | (defn- select-identical
[model entity]
(->> (or (identity-condition model)
(throw (ex-info (trs "Model {0} does not support upsert" model) {:model model})))
(select-keys entity)
(m/map-vals (fn [v]
(if (coll? v)
(json/encode v)
v)))
(m/mapply t2/select-one model))) |
(defn- has-post-insert? [model] (not (methodical/is-default-primary-method? t2.after/each-row-fn [:toucan.query-type/insert.* model]))) | |
Execute body and catch and log any exceptions doing so throws. | (defmacro with-error-handling
[message & body]
`(try
(do ~@body)
(catch Throwable e#
(log/error e# (u/format-color 'red "%s: %s" ~message (.getMessage e#)))
nil))) |
(defn- insert-many-individually!
[model on-error entities]
(for [entity entities]
(when-let [entity-id (if (= :abort on-error)
(first (t2/insert-returning-pks! model entity))
(with-error-handling
(trs "Error inserting {0}" (name-for-logging model entity))
(first (t2/insert-returning-pks! model entity))))]
entity-id))) | |
(defn- maybe-insert-many!
[model on-error entities]
(if (has-post-insert? model)
(insert-many-individually! model on-error entities)
(if (= :abort on-error)
(t2/insert-returning-pks! model entities)
(try
(t2/insert-returning-pks! model entities)
;; Retry each individually so we can do as much as we can
(catch Throwable _
(insert-many-individually! model on-error entities)))))) | |
Return | (defn- group-by-action
[{:keys [mode]} model entities]
(let [same? (comp nil? second data/diff)]
(->> entities
(map-indexed (fn [position entity]
[position
entity
(select-identical model entity)]))
(group-by (fn [[_ entity existing]]
(case mode
:update (cond
(same? existing entity) :skip
existing :update
:else :insert)
:skip (if existing
:skip
:insert))))))) |
Batch upsert many entities. Within the | (defn maybe-upsert-many!
[{:keys [mode on-error pre-insert-fn post-insert-fn]
:or {pre-insert-fn identity
post-insert-fn identity}
:as context}
model
entities]
(let [{:keys [update insert skip]} (group-by-action context model entities)]
(doseq [[_ entity _] insert]
(log/info (trs "Inserting {0}" (name-for-logging (name model) entity))))
(doseq [[_ _ existing] skip]
(if (= mode :skip)
(log/info (trs "{0} already exists -- skipping" (name-for-logging (name model) existing)))
(log/info (trs "Skipping {0} (nothing to update)" (name-for-logging (name model) existing)))))
(doseq [[_ _ existing] update]
(log/info (trs "Updating {0}" (name-for-logging (name model) existing))))
(->> (concat (for [[position _ existing] skip]
[(u/the-id existing) position])
(map vector (map post-insert-fn
(maybe-insert-many! model on-error (map (comp pre-insert-fn second) insert)))
(map first insert))
(for [[position entity existing] update]
(let [id (u/the-id existing)]
(if (= on-error :abort)
(t2/update! model id entity)
(with-error-handling
(trs "Error updating {0}" (name-for-logging (name model) entity))
(t2/update! model id entity)))
[id position])))
(sort-by second)
(map first)))) |
Finds all models with Note that cross-JVM portability is required - but that's specified for [[java.util.Random]], so this should produce identical IDs on all platforms and JVM implementations. | (ns metabase-enterprise.serialization.v2.backfill-ids (:require [metabase-enterprise.serialization.v2.models :as serdes.models] [metabase.models.interface :as mi] [metabase.models.serialization :as serdes] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [toucan2.core :as t2] [toucan2.model :as t2.model])) |
Updates all rows of a particular model to have | (defn backfill-ids-for!
[model]
(let [missing (t2/select model :entity_id nil)
pk (first (t2/primary-keys model))]
(when (seq missing)
(log/info (trs "Backfilling entity_id for {0} rows of {1}" (pr-str (count missing)) (name model)))
(doseq [entity missing
:let [hashed (serdes/identity-hash entity)
eid (u/generate-nano-id hashed)]]
(t2/update! model (get entity pk) {:entity_id eid}))))) |
Returns true if the model has an | (defn has-entity-id?
[model]
(or
;; toucan1 models
(isa? model ::mi/entity-id)
;; toucan2 models
(isa? model :hook/entity-id))) |
Updates all rows of all models that are (a) serialized and (b) have | (defn backfill-ids!
[]
(doseq [model-name (concat serdes.models/exported-models serdes.models/inlined-models)
:let [model (t2.model/resolve-model (symbol model-name))]
:when (has-entity-id? model)]
(backfill-ids-for! model))) |
(ns metabase-enterprise.serialization.v2.entity-ids (:require [clojure.set :as set] [clojure.string :as str] [metabase.db :as mdb] [metabase.db.connection :as mdb.connection] [metabase.models] [metabase.models.serialization :as serdes] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [toucan2.core :as t2])) | |
(set! *warn-on-reflection* true) | |
make sure all the models get loaded up so we can resolve them based on their table names. TODO -- what about enterprise models that have | (comment metabase.models/keep-me) |
Return a set of lower-cased names of all application database tables that have an | (defn- entity-id-table-names
[]
(with-open [conn (.getConnection mdb.connection/*application-db*)]
(let [dbmeta (.getMetaData conn)]
(with-open [tables-rset (.getTables dbmeta nil nil nil (into-array String ["TABLE"]))]
(let [non-view-tables (into #{} (map (comp u/lower-case-en :table_name)) (resultset-seq tables-rset))]
(with-open [rset (.getColumns dbmeta nil nil nil (case (mdb.connection/db-type)
:h2 "ENTITY_ID"
(:mysql :postgres) "entity_id"))]
(let [entity-id-tables (into #{} (map (comp u/lower-case-en :table_name)) (resultset-seq rset))]
(set/intersection non-view-tables entity-id-tables)))))))) |
Return a list of all toucan models. | (defn toucan-models
[]
(->> (descendants :metabase/model)
(filter #(= (namespace %) "model")))) |
Create a map of (lower-cased) application DB table name -> corresponding Toucan model. | (defn- make-table-name->model
[]
(into {}
(for [model (toucan-models)
:let [table-name (some-> model t2/table-name name)]
:when table-name
;; ignore any models defined in test namespaces.
:when (not (str/includes? (namespace model) "test"))]
[table-name model]))) |
Return a set of all Toucan models that have an | (defn- entity-id-models
[]
(let [entity-id-table-names (entity-id-table-names)
table-name->model (make-table-name->model)
entity-id-table-name->model (into {}
(map (fn [table-name]
(if-let [model (table-name->model table-name)]
[table-name model]
(throw (ex-info (trs "Model not found for table {0}" table-name)
{:table-name table-name})))))
entity-id-table-names)
entity-id-models (set (vals entity-id-table-name->model))]
;; make sure we've resolved all of the tables that have entity_id to their corresponding models.
(when-not (= (count entity-id-table-names)
(count entity-id-models))
(throw (ex-info (trs "{0} tables have entity_id; expected to resolve the same number of models, but only got {1}"
(count entity-id-table-names)
(count entity-id-models))
{:tables entity-id-table-names
:resolved entity-id-table-name->model})))
(set entity-id-models))) |
(defn- seed-entity-id-for-instance! [model instance]
(try
(let [primary-key (first (t2/primary-keys model))
pk-value (get instance primary-key)]
(when-not (some? pk-value)
(throw (ex-info (format "Missing value for primary key column %s" (pr-str primary-key))
{:model (name model)
:instance instance
:primary-key primary-key})))
(let [new-hash (serdes/identity-hash instance)]
(log/infof "Update %s %s entity ID => %s" (name model) (pr-str pk-value) (pr-str new-hash))
(t2/update! model pk-value {:entity_id new-hash}))
{:update-count 1})
(catch Throwable e
(log/errorf e "Error updating entity ID: %s" (ex-message e))
{:error-count 1}))) | |
(defn- seed-entity-ids-for-model! [model]
(log/infof "Seeding Entity IDs for model %s" (name model))
(let [reducible-instances (t2/reducible-select model :entity_id nil)]
(transduce
(map (fn [instance]
(seed-entity-id-for-instance! model instance)))
(completing
(partial merge-with +)
(fn [{:keys [update-count error-count], :as results}]
(when (pos? update-count)
(log/infof "Updated %d %s instance(s) successfully." update-count (name model)))
(when (pos? error-count)
(log/infof "Failed to update %d %s instance(s) because of errors." error-count (name model)))
results))
{:update-count 0, :error-count 0}
reducible-instances))) | |
Create entity IDs for any instances of models that support them but do not have them, i.e. find instances of models
that have an Returns truthy if all missing entity IDs were created successfully, and falsey if there were any errors. | (defn seed-entity-ids!
[]
(log/info "Seeding Entity IDs")
(mdb/setup-db!)
(let [{:keys [error-count]} (transduce
(map seed-entity-ids-for-model!)
(completing (partial merge-with +))
{:update-count 0, :error-count 0}
(entity-id-models))]
(zero? error-count))) |
(defn- drop-entity-ids-for-model! [model]
(log/infof "Dropping Entity IDs for model %s" (name model))
(try
(let [update-count (t2/update! model {:entity_id nil})]
(when (pos? update-count)
(log/infof "Updated %d %s instance(s) successfully." update-count (name model)))
{:update-count update-count})
(catch Throwable e
(log/errorf e "Error dropping entity ID: %s" (ex-message e))
{:error-count 1}))) | |
Delete entity IDs for any models that have them. See #34871. Returns truthy if all entity IDs were removed successfully, and falsey if there were any errors. | (defn drop-entity-ids!
[]
(log/info "Dropping Entity IDs")
(mdb/setup-db!)
(let [{:keys [error-count]} (transduce
(map drop-entity-ids-for-model!)
(completing (partial merge-with +))
{:update-count 0, :error-count 0}
(entity-id-models))]
(zero? error-count))) |
Extraction is the first step in serializing a Metabase appdb so it can be eg. written to disk. See the detailed descriptions of the (de)serialization processes in [[metabase.models.serialization]]. | (ns metabase-enterprise.serialization.v2.extract (:require [clojure.set :as set] [clojure.string :as str] [metabase-enterprise.serialization.v2.backfill-ids :as serdes.backfill] [metabase-enterprise.serialization.v2.models :as serdes.models] [metabase.models :refer [Card Collection Dashboard DashboardCard]] [metabase.models.collection :as collection] [metabase.models.serialization :as serdes] [metabase.util :as u] [metabase.util.log :as log] [toucan2.core :as t2])) |
(set! *warn-on-reflection* true) | |
Returns a set of models to export based on export opts | (defn- model-set
[opts]
(cond-> #{}
(:include-field-values opts)
(conj "FieldValues")
(not (:no-collections opts))
(into serdes.models/content)
(not (:no-data-model opts))
(into serdes.models/data-model)
(not (:no-settings opts))
(conj "Setting"))) |
Returns target seq filtered on given model name | (defn targets-of-type [targets model-name] (filter #(= (first %) model-name) targets)) |
Returns a targets seq with model type and given ids | (defn make-targets-of-type [model-name ids] (mapv vector (repeat model-name) ids)) |
Returns a set of collection IDs to export for the provided user, if any. If user-id is nil, do not include any personally-owned collections. Does not export ee-only analytics collections. | (defn- collection-set-for-user
[user-id]
(let [roots (t2/select Collection {:where [:and [:= :location "/"]
[:or [:= :personal_owner_id nil]
[:= :personal_owner_id user-id]]
[:or [:= :namespace nil]
[:!= :namespace "analytics"]]]})]
;; start with the special "nil" root collection ID
(-> #{nil}
(into (map :id) roots)
(into (mapcat collection/descendant-ids) roots)))) |
Returns reducible stream of serializable entity maps, with | (defn- extract-metabase
[{:keys [user-id] :as opts}]
(log/tracef "Extracting Metabase with options: %s" (pr-str opts))
(let [extract-opts (assoc opts :collection-set (collection-set-for-user user-id))]
(eduction (map #(serdes/extract-all % extract-opts)) cat (model-set opts)))) |
Given a target seq, explore the contents of any collections looking for "leaks". For example, a Dashboard that contains Cards which are not (transitively) in the given set of collections, or a Card that depends on a Card as a model, which is not in the given collections. Returns a data structure detailing the gaps. Use [[escape-report]] to output this data in a human-friendly format. Returns nil if there are no escaped values, which is useful for a test. | (defn- escape-analysis
[targets]
(let [collection-ids (into #{} (map second) (targets-of-type targets "Collection"))
collection-set (into collection-ids (mapcat collection/descendant-ids) (t2/select Collection :id [:in collection-ids]))
dashboards (t2/select Dashboard :collection_id [:in collection-set])
;; All cards that are in this collection set.
cards (reduce set/union #{} (for [coll-id collection-set]
(t2/select-pks-set Card :collection_id coll-id)))
;; Map of {dashboard-id #{DashboardCard}} for dashcards whose cards OR parameter-bound cards are outside the
;; transitive collection set.
escaped-dashcards (into {}
(for [dash dashboards
:let [dcs (t2/select DashboardCard :dashboard_id (:id dash))
escapees (->> dcs
(keep :card_id) ; Text cards have a nil card_id
set)
params (->> dcs
(mapcat :parameter_mappings)
(keep :card_id)
set)
combined (set/difference (set/union escapees params) cards)]
:when (seq combined)]
[(:id dash) combined]))
;; {source-card-id target-card-id} the key is in the curated set, the value is not.
all-cards (for [id cards]
(t2/select-one [Card :id :collection_id :dataset_query] :id id))
bad-source (for [card all-cards
:let [^String src (some-> card :dataset_query :query :source-table)]
:when (and (string? src) (.startsWith src "card__"))
:let [card-id (Integer/parseInt (.substring src 6))]
:when (not (cards card-id))]
[(:id card) card-id])
bad-template-tags (for [card all-cards
:let [card-ids (some->> card :dataset_query :native
:template-tags vals (keep :card-id))]
card-id card-ids
:when (not (cards card-id))]
[(:id card) card-id])
escaped-questions (into {} (concat bad-source bad-template-tags))
problem-cards (reduce set/union (set (vals escaped-questions)) (vals escaped-dashcards))]
(cond-> nil
(seq escaped-dashcards) (assoc :escaped-dashcards escaped-dashcards)
(seq escaped-questions) (assoc :escaped-questions escaped-questions)
(seq problem-cards) (assoc :problem-cards problem-cards)))) |
(defn- collection-label [coll-id]
(if coll-id
(let [collection (t2/hydrate (t2/select-one Collection :id coll-id) :ancestors)
names (->> (conj (:ancestors collection) collection)
(map :name)
(str/join " > "))]
(format "%d: %s" coll-id names))
"[no collection]")) | |
(defn- card-label [card-id]
(let [card (t2/select-one [Card :collection_id :name] :id card-id)]
(format "Card %d (%s from collection %s)" card-id (:name card) (collection-label (:collection_id card))))) | |
Given the analysis map from [[escape-analysis]], report the results in a human-readable format with Card titles etc. | (defn- escape-report
[{:keys [escaped-dashcards escaped-questions]}]
(when-not (empty? escaped-dashcards)
(doseq [[dash-id card-ids] escaped-dashcards
:let [dash-name (t2/select-one-fn :name Dashboard :id dash-id)]]
(log/warnf "Failed to export Dashboard %d (%s) containing Cards saved outside requested collections: %s"
dash-id dash-name (str/join ", " (map card-label card-ids)))))
(when-not (empty? escaped-questions)
(log/warnf "Failed to export Cards based on questions outside requested collections: %s"
(str/join ", " (for [[curated-id alien-id] escaped-questions]
(str (card-label curated-id) " -> " (card-label alien-id))))))) |
Extracts the targeted entities and all their descendants into a reducible stream of extracted maps. The targeted entities are specified as a list of [[serdes/descendants]] is recursively called on these entities and all their descendants, until the
complete transitive closure of all descendants is found. This produces a set of | (defn- extract-subtrees
[{:keys [targets] :as opts}]
(log/tracef "Extracting subtrees with options: %s" (pr-str opts))
(if-let [analysis (escape-analysis targets)]
;; If that is non-nil, emit the report.
(escape-report analysis)
;; If it's nil, there are no errors, and we can proceed to do the dump.
;; TODO This is not handled at all, but we should be able to exclude illegal data - and it should be
;; contagious. Eg. a Dashboard with an illegal Card gets excluded too.
(let [nodes (set/union
(u/traverse targets #(serdes/ascendants (first %) (second %)))
(u/traverse targets #(serdes/descendants (first %) (second %))))
models (model-set opts)
;; filter the selected models based on user options
by-model (-> (group-by first nodes)
(select-keys models)
(update-vals #(set (map second %))))
extract-ids (fn [[model ids]]
(eduction (map #(serdes/extract-one model opts %))
(t2/reducible-select (symbol model) :id [:in ids])))]
(eduction cat
[(eduction (map extract-ids) cat by-model)
;; extract all non-content entities like data model and settings if necessary
(eduction (map #(serdes/extract-all % opts)) cat (remove (set serdes.models/content) models))])))) |
Returns a reducible stream of entities to serialize | (defn extract
[{:keys [targets] :as opts}]
(serdes.backfill/backfill-ids!)
(if (seq targets)
(extract-subtrees opts)
(extract-metabase opts))) |
Ingestion is the first step in deserialization - reading from the export format (eg. a tree of YAML files) and
producing Clojure maps with See the detailed description of the (de)serialization processes in [[metabase.models.serialization]]. | (ns metabase-enterprise.serialization.v2.ingest (:require [clojure.java.io :as io] [clojure.string :as str] [metabase.models.serialization :as serdes] [metabase.util.date-2 :as u.date] [metabase.util.yaml :as yaml] [potemkin.types :as p]) (:import (java.io File))) |
(set! *warn-on-reflection* true) | |
(p/defprotocol+ Ingestable
;; Represents a data source for deserializing previously-exported appdb content into this Metabase instance.
;; This is written as a protocol since overriding it with [[reify]] is useful for testing.
(ingest-list
[this]
"Return a reducible stream of `:serdes/meta`-style abstract paths, one for each entity in the dump.
See the description of these abstract paths in [[metabase.models.serialization]].
Each path is ordered from the root to the leaf.
The order of the whole list is not specified and should not be relied upon!")
(ingest-one
[this path]
"Given one of the `:serdes/meta` abstract paths returned by [[ingest-list]], read in and return the entire
corresponding entity.")) | |
(defn- read-timestamps [entity]
(->> (keys entity)
(filter #(or (#{:last_analyzed} %)
(.endsWith (name %) "_at")))
(reduce #(update %1 %2 u.date/parse) entity))) | |
Convert suitable string keys to clojure keywords, ignoring keys with whitespace, etc. | (defn- parse-key
[{k :key}]
(if (re-matches #"^[0-9a-zA-Z_\./\-]+$" k)
(keyword k)
k)) |
(defn- strip-labels [hierarchy] (mapv #(dissoc % :label) hierarchy)) | |
Reads an entity YAML file and clean it up (eg. parsing timestamps)
The returned entity is in "extracted" form, ready to be passed to the | (defn- ingest-file
[file]
(-> file
(yaml/from-file {:key-fn parse-key})
read-timestamps)) |
(def ^:private legal-top-level-paths
#{"actions" "collections" "databases" "snippets"}) ; But return the hierarchy without labels. | |
(defn- ingest-all [^File root-dir]
;; This returns a map {unlabeled-hierarchy [original-hierarchy File]}.
(into {} (for [^File file (file-seq root-dir)
:when (and (.isFile file)
(str/ends-with? (.getName file) ".yaml")
(let [rel (.relativize (.toPath root-dir) (.toPath file))]
(-> rel (.subpath 0 1) (.toString) legal-top-level-paths)))
;; TODO: only load YAML once.
:let [hierarchy (serdes/path (ingest-file file))]]
[(strip-labels hierarchy) [hierarchy file]]))) | |
(deftype YamlIngestion [^File root-dir settings cache]
Ingestable
(ingest-list [_]
(-> (or @cache (reset! cache (ingest-all root-dir)))
keys
;; add settings ingestion paths
(concat (for [k (keys settings)]
[{:model "Setting" :id (name k)}]))))
(ingest-one [_ abs-path]
(when-not @cache
(reset! cache (ingest-all root-dir)))
(let [{:keys [id]} (first abs-path)
kw-id (keyword id)]
(if (= ["Setting"] (mapv :model abs-path))
{:serdes/meta abs-path :key kw-id :value (get settings kw-id)}
(->> abs-path
strip-labels
(get @cache)
second
ingest-file))))) | |
Creates a new Ingestable on a directory of YAML files, as created by [[metabase-enterprise.serialization.v2.storage.yaml]]. | (defn ingest-yaml [root-dir] (->YamlIngestion (io/file root-dir) (yaml/from-file (io/file root-dir "settings.yaml")) (atom nil))) |
Loading is the interesting part of deserialization: integrating the maps "ingested" from files into the appdb. See the detailed breakdown of the (de)serialization processes in [[metabase.models.serialization]]. | (ns metabase-enterprise.serialization.v2.load (:require [medley.core :as m] [metabase-enterprise.serialization.v2.backfill-ids :as serdes.backfill] [metabase-enterprise.serialization.v2.ingest :as serdes.ingest] [metabase.models.serialization :as serdes] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log])) |
(declare load-one!) | |
Given a list of | (defn- load-deps!
[ctx deps]
(if (empty? deps)
ctx
(letfn [(loader [ctx dep]
(try
(load-one! ctx dep)
(catch Exception e
(if (and (= (:error (ex-data e)) ::not-found)
(serdes/load-find-local dep))
;; It was missing but we found it locally, so just return the context.
ctx
;; Different error, or couldn't find it locally, so rethrow.
(throw e)))))]
(reduce loader ctx deps)))) |
Loads a single entity, specified by its If the incoming entity has any dependencies, they are recursively processed first (postorder) so that any foreign key references in this entity can be resolved properly. This is mostly bookkeeping for the overall deserialization process - the actual load of any given entity is done by [[metabase.models.serialization/load-one!]] and its various overridable parts, which see. Circular dependencies are not allowed, and are detected and thrown as an error. | (defn- load-one!
[{:keys [expanding ingestion seen] :as ctx} path]
(log/info (trs "Loading {0}" (serdes/log-path-str path)))
(cond
(expanding path) (throw (ex-info (format "Circular dependency on %s" (pr-str path)) {:path path}))
(seen path) ctx ; Already been done, just skip it.
:else (let [ingested (try
(serdes.ingest/ingest-one ingestion path)
(catch Exception e
(throw (ex-info (format "Failed to read file for %s" (pr-str path))
{:path path
:deps-chain expanding
:error ::not-found}
e))))
deps (serdes/dependencies ingested)
ctx (-> ctx
(update :expanding conj path)
(load-deps! deps)
(update :seen conj path)
(update :expanding disj path))
;; Use the abstract path as attached by the ingestion process, not the original one we were passed.
rebuilt-path (serdes/path ingested)
local-or-nil (serdes/load-find-local rebuilt-path)]
(try
(serdes/load-one! ingested local-or-nil)
ctx
(catch Exception e
(throw (ex-info (format "Failed to load into database for %s" (pr-str path))
{:path path
:deps-chain expanding}
e))))))) |
(defn- try-load-one!
[ctx path]
(try
(load-one! ctx path)
(catch Exception e
(log/error (trs "Error importing {0}. Continuing..." (serdes/log-path-str path)))
(update ctx :errors conj e)))) | |
Loads in a database export from an ingestion source, which is any Ingestable instance. | (defn load-metabase!
[ingestion & {:keys [abort-on-error backfill?]
:or {abort-on-error true
backfill? true}}]
;; We proceed in the arbitrary order of ingest-list, deserializing all the files. Their declared dependencies guide
;; the import, and make sure all containers are imported before contents, etc.
(when backfill?
(serdes.backfill/backfill-ids!))
(let [contents (serdes.ingest/ingest-list ingestion)
ctx {:expanding #{}
:seen #{}
:ingestion ingestion
:from-ids (m/index-by :id contents)
:errors []}
result (reduce (if abort-on-error load-one! try-load-one!) ctx contents)]
(when-let [errors (seq (:errors result))]
(log/error (trs "Errors were encountered during import."))
(doseq [e errors]
(log/error e "Import error details:")))
result)) |
(ns metabase-enterprise.serialization.v2.models) | |
Schema model types | (def data-model ["Database" "Field" "Metric" "Segment" "Table"]) |
Content model types | (def content ["Action" "Card" "Collection" "Dashboard" "NativeQuerySnippet" "Timeline"]) |
The list of all models exported by serialization by default. Used for production code and by tests. | (def exported-models
(concat data-model
content
["FieldValues"
"Setting"])) |
An additional list of models which are inlined into parent entities for serialization. These are not extracted and serialized separately, but they may need some processing done. For example, the models should also have their entity_id fields populated (if they have one). | (def inlined-models ["DashboardCard" "DashboardTab" "Dimension" "ParameterCard" "DashboardCardSeries" "TimelineEvent"]) |
List of models which are not going to be serialized ever. | (def excluded-models ["Activity" "ApiKey" "ApplicationPermissionsRevision" "AuditLog" "BookmarkOrdering" "CardBookmark" "CollectionBookmark" "CollectionPermissionGraphRevision" "ConnectionImpersonation" "DashboardBookmark" "GroupTableAccessPolicy" "HTTPAction" "ImplicitAction" "LoginHistory" "MetricImportantField" "ModelIndex" "ModelIndexValue" "ModerationReview" "Permissions" "PermissionsGroup" "PermissionsGroupMembership" "PermissionsRevision" "PersistedInfo" "Pulse" "PulseCard" "PulseChannel" "PulseChannelRecipient" "Query" "QueryAction" "QueryCache" "QueryExecution" "RecentViews" "Revision" "Secret" "Session" "TablePrivileges" "TaskHistory" "User" "ViewLog"]) |
(ns metabase-enterprise.serialization.v2.storage
(:require [clojure.java.io :as io]
[clojure.string :as str]
[metabase-enterprise.serialization.dump :refer [spit-yaml!]]
[metabase.models.serialization :as serdes]
[metabase.util.i18n :refer [trs]]
[metabase.util.log :as log])) | |
(set! *warn-on-reflection* true) | |
Given a path segment, which is supposed to be the name of a single file or directory, escape any slashes inside it.
This occurs in practice, for example with a | (defn- escape-segment
[segment]
(-> segment
(str/replace "/" "__SLASH__")
(str/replace "\\" "__BACKSLASH__"))) |
(defn- file
[ctx entity]
(let [;; Get the desired [[serdes/storage-path]].
base-path (serdes/storage-path entity ctx)
dirnames (drop-last base-path)
;; Attach the file extension to the last part.
basename (str (last base-path) ".yaml")]
(apply io/file (:root-dir ctx) (map escape-segment (concat dirnames [basename]))))) | |
(defn- store-entity! [opts entity]
(log/info (trs "Storing {0}" (serdes/log-path-str (:serdes/meta entity))))
(spit-yaml! (file opts entity) entity)) | |
(defn- store-settings! [{:keys [root-dir]} settings]
(when (seq settings)
(let [as-map (into (sorted-map)
(for [{:keys [key value]} settings]
[key value]))]
(spit-yaml! (io/file root-dir "settings.yaml") as-map)))) | |
Helper for storing a serialized database to a tree of YAML files. | (defn store!
[stream root-dir]
(let [settings (atom [])
opts (merge {:root-dir root-dir} (serdes/storage-base-context))]
(doseq [entity stream]
(if (-> entity :serdes/meta last :model (= "Setting"))
(swap! settings conj entity)
(store-entity! opts entity)))
(store-settings! opts @settings))) |
(ns metabase-enterprise.snippet-collections.api.native-query-snippet (:require [metabase.public-settings.premium-features :refer [defenterprise]] [metabase.util.honey-sql-2 :as h2x])) | |
Clause to filter out snippet collections from the collection query on OSS instances, and instances without the
snippet-collections feature flag. EE implementation returns | (defenterprise snippets-collection-filter-clause :feature :snippet-collections []) |
Collection children query for snippets on EE. | (defenterprise snippets-collection-children-query
:feature :snippet-collections
[collection {:keys [archived?]}]
{:select [:id :name :entity_id [(h2x/literal "snippet") :model]]
:from [[:native_query_snippet :nqs]]
:where [:and
[:= :collection_id (:id collection)]
[:= :archived (boolean archived?)]]}) |
EE implementation of NativeQuerySnippet permissions. | (ns metabase-enterprise.snippet-collections.models.native-query-snippet.permissions
(:require
[metabase.models.interface :as mi]
[metabase.models.native-query-snippet.permissions :as snippet.perms]
[metabase.models.permissions :as perms]
[metabase.public-settings.premium-features
:as premium-features
:refer [defenterprise]]
[metabase.util.malli :as mu]
[metabase.util.malli.schema :as ms]
[toucan2.core :as t2])) |
(mu/defn ^:private has-parent-collection-perms? [snippet :- [:map [:collection_id [:maybe ms/PositiveInt]]] read-or-write :- [:enum :read :write]] (mi/current-user-has-full-permissions? (perms/perms-objects-set-for-parent-collection "snippets" snippet read-or-write))) | |
Can the current User read this | (defenterprise can-read?
:feature :snippet-collections
([snippet]
(and
(not (premium-features/sandboxed-user?))
(snippet.perms/has-any-native-permissions?)
(has-parent-collection-perms? snippet :read)))
([model id]
(can-read? (t2/select-one [model :collection_id] :id id)))) |
Can the current User edit this | (defenterprise can-write?
:feature :snippet-collections
([snippet]
(and
(not (premium-features/sandboxed-user?))
(snippet.perms/has-any-native-permissions?)
(has-parent-collection-perms? snippet :write)))
([model id]
(can-write? (t2/select-one [model :collection_id] :id id)))) |
Can the current User save a new Snippet with the values in | (defenterprise can-create? :feature :snippet-collections [_model m] (and (not (premium-features/sandboxed-user?)) (snippet.perms/has-any-native-permissions?) (has-parent-collection-perms? m :write))) |
Can the current User apply a map of | (defenterprise can-update?
:feature :snippet-collections
[snippet changes]
(and
(not (premium-features/sandboxed-user?))
(snippet.perms/has-any-native-permissions?)
(has-parent-collection-perms? snippet :write)
(or (not (contains? changes :collection_id))
(has-parent-collection-perms? changes :write)))) |
(ns metabase-enterprise.sso.api.interface (:require [metabase-enterprise.sso.integrations.sso-settings :as sso-settings] [metabase.util.i18n :refer [tru]])) | |
Function that powers the defmulti in figuring out which SSO backend to use. It might be that we need to have more complex logic around this, but now it's just a simple priority. If SAML is configured use that otherwise JWT | (defn- sso-backend
[_]
(cond
(sso-settings/saml-enabled) :saml
(sso-settings/jwt-enabled) :jwt
:else nil)) |
Multi-method for supporting the first part of an SSO signin request. An implementation of this method will usually result in a redirect to an SSO backend | (defmulti sso-get sso-backend) |
Multi-method for supporting a POST-back from an SSO signin request. An implementation of this method will need to validate the POST from the SSO backend and successfully log the user into Metabase. | (defmulti sso-post sso-backend) |
(defn- throw-not-configured-error []
(throw (ex-info (str (tru "SSO has not been enabled and/or configured"))
{:status-code 400}))) | |
(defmethod sso-get :default [_] (throw-not-configured-error)) | |
(defmethod sso-post :default [_] (throw-not-configured-error)) | |
(ns metabase-enterprise.sso.api.routes (:require [compojure.core :as compojure] [metabase-enterprise.sso.api.saml :as saml] [metabase-enterprise.sso.api.sso :as sso])) | |
Ring routes for auth (SAML) API endpoints. This needs to be injected into [[metabase.server.routes/routes]] -- not [[metabase.api.routes/routes]] !!! TODO -- should we make a TODO -- we need to feature-flag this based on the | (compojure/defroutes routes
(compojure/context
"/auth"
[]
(compojure/routes
(compojure/context "/sso" [] sso/routes)))
(compojure/context
"/api"
[]
(compojure/routes
(compojure/context "/saml" [] saml/routes)))) |
| (ns metabase-enterprise.sso.api.saml (:require [clojure.string :as str] [compojure.core :refer [PUT]] [metabase.api.common :as api] [metabase.models.setting :as setting] [metabase.public-settings.premium-features :as premium-features] [metabase.util.i18n :refer [tru]] [saml20-clj.core :as saml])) |
(set! *warn-on-reflection* true) | |
/settings | (api/defendpoint PUT
"Update SAML related settings. You must be a superuser to do this."
[:as {settings :body}]
{settings :map}
(api/check-superuser)
(premium-features/assert-has-feature :sso-saml (tru "SAML-based authentication"))
(let [filename (:saml-keystore-path settings)
password (:saml-keystore-password settings)
alias (:saml-keystore-alias settings)]
(if (or (every? str/blank? [filename password alias])
(saml/has-private-key? {:filename filename
:password password
:alias alias}))
(setting/set-many! settings)
;; test failed, return result message
{:status 400
:body "Error finding private key in provided keystore and alias."}))) |
(api/define-routes) | |
Implements the SSO routes needed for SAML and JWT. This namespace primarily provides hooks for those two backends so we can have a uniform interface both via the API and code | (ns metabase-enterprise.sso.api.sso (:require [compojure.core :refer [GET POST]] [metabase-enterprise.sso.api.interface :as sso.i] [metabase-enterprise.sso.integrations.jwt] [metabase-enterprise.sso.integrations.saml] [metabase.api.common :as api] [metabase.util :as u] [metabase.util.i18n :refer [trs]] [metabase.util.log :as log] [stencil.core :as stencil])) |
(set! *warn-on-reflection* true) | |
load the SSO integrations so their implementations for the multimethods below are available. | (comment metabase-enterprise.sso.integrations.jwt/keep-me
metabase-enterprise.sso.integrations.saml/keep-me) |
/ | (api/defendpoint GET
"SSO entry-point for an SSO user that has not logged in yet"
[:as req]
(try
(sso.i/sso-get req)
(catch Throwable e
(log/error #_e (trs "Error returning SSO entry point"))
(throw e)))) |
(defn- sso-error-page [^Throwable e]
{:status (get (ex-data e) :status-code 500)
:headers {"Content-Type" "text/html"}
:body (stencil/render-file "metabase_enterprise/sandbox/api/error_page"
(let [message (.getMessage e)
data (u/pprint-to-str (ex-data e))]
{:errorMessage message
:exceptionClass (.getName Exception)
:additionalData data}))}) | |
/ | (api/defendpoint POST
"Route the SSO backends call with successful login details"
[:as req]
(try
(sso.i/sso-post req)
(catch Throwable e
(log/error e (trs "Error logging in"))
(sso-error-page e)))) |
(api/define-routes) | |
Implementation of the JWT backend for sso | (ns metabase-enterprise.sso.integrations.jwt (:require [buddy.sign.jwt :as jwt] [clojure.string :as str] [java-time.api :as t] [metabase-enterprise.sso.api.interface :as sso.i] [metabase-enterprise.sso.integrations.sso-settings :as sso-settings] [metabase-enterprise.sso.integrations.sso-utils :as sso-utils] [metabase.api.common :as api] [metabase.api.session :as api.session] [metabase.integrations.common :as integrations.common] [metabase.public-settings.premium-features :as premium-features] [metabase.server.middleware.session :as mw.session] [metabase.server.request.util :as request.u] [metabase.util.i18n :refer [tru]] [ring.util.response :as response]) (:import (java.net URLEncoder))) |
(set! *warn-on-reflection* true) | |
Returns a session map for the given | (defn fetch-or-create-user!
[first-name last-name email user-attributes]
(when-not (sso-settings/jwt-enabled)
(throw (IllegalArgumentException. (str (tru "Can't create new JWT user when JWT is not configured")))))
(let [user {:first_name first-name
:last_name last-name
:email email
:sso_source :jwt
:login_attributes user-attributes}]
(or (sso-utils/fetch-and-update-login-attributes! user)
(sso-utils/check-user-provisioning :jwt)
(sso-utils/create-new-sso-user! user)))) |
(def ^:private ^{:arglists '([])} jwt-attribute-email (comp keyword sso-settings/jwt-attribute-email))
(def ^:private ^{:arglists '([])} jwt-attribute-firstname (comp keyword sso-settings/jwt-attribute-firstname))
(def ^:private ^{:arglists '([])} jwt-attribute-lastname (comp keyword sso-settings/jwt-attribute-lastname))
(def ^:private ^{:arglists '([])} jwt-attribute-groups (comp keyword sso-settings/jwt-attribute-groups)) | |
(defn- jwt-data->login-attributes [jwt-data]
(dissoc jwt-data
(jwt-attribute-email)
(jwt-attribute-firstname)
(jwt-attribute-lastname)
:iat
:max_age)) | |
JWTs use seconds since Epoch, not milliseconds since Epoch for the | (def ^:private ^:const three-minutes-in-seconds 180) |
Translate a user's group names to a set of MB group IDs using the configured mappings | (defn- group-names->ids
[group-names]
(set (mapcat (sso-settings/jwt-group-mappings)
(map keyword group-names)))) |
Returns the set of all MB group IDs that have configured mappings | (defn- all-mapped-group-ids
[]
(-> (sso-settings/jwt-group-mappings)
vals
flatten
set)) |
Sync a user's groups based on mappings configured in the JWT settings | (defn- sync-groups!
[user jwt-data]
(when (sso-settings/jwt-group-sync)
(when-let [groups-attribute (jwt-attribute-groups)]
(when-let [group-names (get jwt-data groups-attribute)]
(integrations.common/sync-group-memberships! user
(group-names->ids group-names)
(all-mapped-group-ids)))))) |
(defn- login-jwt-user
[jwt {{redirect :return_to} :params, :as request}]
(let [redirect-url (or redirect (URLEncoder/encode "/"))]
(sso-utils/check-sso-redirect redirect-url)
(let [jwt-data (try
(jwt/unsign jwt (sso-settings/jwt-shared-secret)
{:max-age three-minutes-in-seconds})
(catch Throwable e
(throw (ex-info (ex-message e)
(assoc (ex-data e) :status-code 401)
e))))
login-attrs (jwt-data->login-attributes jwt-data)
email (get jwt-data (jwt-attribute-email))
first-name (get jwt-data (jwt-attribute-firstname))
last-name (get jwt-data (jwt-attribute-lastname))
user (fetch-or-create-user! first-name last-name email login-attrs)
session (api.session/create-session! :sso user (request.u/device-info request))]
(sync-groups! user jwt-data)
(mw.session/set-session-cookies request (response/redirect redirect-url) session (t/zoned-date-time (t/zone-id "GMT")))))) | |
(defn- check-jwt-enabled []
(api/check (sso-settings/jwt-enabled)
[400 (tru "JWT SSO has not been enabled and/or configured")])) | |
(defmethod sso.i/sso-get :jwt
[{{:keys [jwt redirect]} :params, :as request}]
(premium-features/assert-has-feature :sso-jwt (tru "JWT-based authentication"))
(check-jwt-enabled)
(if jwt
(login-jwt-user jwt request)
(let [idp (sso-settings/jwt-identity-provider-uri)
return-to-param (if (str/includes? idp "?") "&return_to=" "?return_to=")]
(response/redirect (str idp (when redirect
(str return-to-param redirect))))))) | |
(defmethod sso.i/sso-post :jwt
[_]
(throw (ex-info "POST not valid for JWT SSO requests" {:status-code 400}))) | |
Implementation of the SAML backend for SSO. The basic flow of of a SAML login is:
| (ns metabase-enterprise.sso.integrations.saml (:require [buddy.core.codecs :as codecs] [clojure.string :as str] [java-time.api :as t] [medley.core :as m] [metabase-enterprise.sso.api.interface :as sso.i] [metabase-enterprise.sso.integrations.sso-settings :as sso-settings] [metabase-enterprise.sso.integrations.sso-utils :as sso-utils] [metabase.api.common :as api] [metabase.api.session :as api.session] [metabase.integrations.common :as integrations.common] [metabase.public-settings :as public-settings] [metabase.public-settings.premium-features :as premium-features] [metabase.server.middleware.session :as mw.session] [metabase.server.request.util :as request.u] [metabase.util :as u] [metabase.util.i18n :refer [trs tru]] [metabase.util.log :as log] [ring.util.response :as response] [saml20-clj.core :as saml] [schema.core :as s]) (:import (java.net URI URISyntaxException) (java.util Base64 UUID))) |
(set! *warn-on-reflection* true) | |
Translate a user's group names to a set of MB group IDs using the configured mappings | (defn- group-names->ids
[group-names]
(->> (cond-> group-names (string? group-names) vector)
(map keyword)
(mapcat (sso-settings/saml-group-mappings))
set)) |
Returns the set of all MB group IDs that have configured mappings | (defn- all-mapped-group-ids
[]
(-> (sso-settings/saml-group-mappings)
vals
flatten
set)) |
Sync a user's groups based on mappings configured in the SAML settings | (defn- sync-groups!
[user group-names]
(when (sso-settings/saml-group-sync)
(when group-names
(integrations.common/sync-group-memberships! user
(group-names->ids group-names)
(all-mapped-group-ids))))) |
(s/defn ^:private fetch-or-create-user! :- (s/maybe {:id UUID, s/Keyword s/Any})
"Returns a Session for the given `email`. Will create the user if needed."
[{:keys [first-name last-name email group-names user-attributes device-info]}]
(when-not (sso-settings/saml-enabled)
(throw (IllegalArgumentException. (tru "Can't create new SAML user when SAML is not enabled"))))
(when-not email
(throw (ex-info (str (tru "Invalid SAML configuration: could not find user email.")
" "
(tru "We tried looking for {0}, but couldn't find the attribute."
(sso-settings/saml-attribute-email))
" "
(tru "Please make sure your SAML IdP is properly configured."))
{:status-code 400, :user-attributes (keys user-attributes)})))
(let [new-user {:first_name first-name
:last_name last-name
:email email
:sso_source :saml
:login_attributes user-attributes}]
(when-let [user (or (sso-utils/fetch-and-update-login-attributes! new-user)
(sso-utils/check-user-provisioning :saml)
(sso-utils/create-new-sso-user! new-user))]
(sync-groups! user group-names)
(api.session/create-session! :sso user device-info)))) | |
SAML route supporting functions | |
(defn- acs-url [] (str (public-settings/site-url) "/auth/sso")) | |
(defn- sp-cert-keystore-details []
(when-let [path (sso-settings/saml-keystore-path)]
(when-let [password (sso-settings/saml-keystore-password)]
(when-let [key-name (sso-settings/saml-keystore-alias)]
{:filename path
:password password
:alias key-name})))) | |
(defn- check-saml-enabled []
(api/check (sso-settings/saml-enabled)
[400 (tru "SAML has not been enabled and/or configured")])) | |
(defn- has-host? [uri]
(try
(-> uri URI. .getHost some?)
(catch URISyntaxException _ false))) | |
(defmethod sso.i/sso-get :saml
;; Initial call that will result in a redirect to the IDP along with information about how the IDP can authenticate
;; and redirect them back to us
[req]
(premium-features/assert-has-feature :sso-saml (tru "SAML-based authentication"))
(check-saml-enabled)
(let [redirect (get-in req [:params :redirect])
redirect-url (if (nil? redirect)
(do
(log/warn (trs "Warning: expected `redirect` param, but none is present"))
(public-settings/site-url))
(if (has-host? redirect)
redirect
(str (public-settings/site-url) redirect)))]
(sso-utils/check-sso-redirect redirect-url)
(try
(let [idp-url (sso-settings/saml-identity-provider-uri)
saml-request (saml/request
{:request-id (str "id-" (random-uuid))
:sp-name (sso-settings/saml-application-name)
:issuer (sso-settings/saml-application-name)
:acs-url (acs-url)
:idp-url idp-url
:credential (sp-cert-keystore-details)})
relay-state (saml/str->base64 redirect-url)]
(saml/idp-redirect-response saml-request idp-url relay-state))
(catch Throwable e
(let [msg (trs "Error generating SAML request")]
(log/error e msg)
(throw (ex-info msg {:status-code 500} e))))))) | |
(defn- validate-response [response]
(let [idp-cert (or (sso-settings/saml-identity-provider-certificate)
(throw (ex-info (str (tru "Unable to log in: SAML IdP certificate is not set."))
{:status-code 500})))]
(try
(saml/validate response idp-cert (sp-cert-keystore-details) {:acs-url (acs-url)
:issuer (sso-settings/saml-identity-provider-issuer)})
(catch Throwable e
(log/error e (trs "SAML response validation failed"))
(throw (ex-info (tru "Unable to log in: SAML response validation failed")
{:status-code 401}
e)))))) | |
(defn- xml-string->saml-response [xml-string] (validate-response (saml/->Response xml-string))) | |
For some reason all of the user attributes coming back from the saml library are wrapped in a list, instead of 'Ryan', it's ('Ryan'). This function discards the list if there's just a single item in it. | (defn- unwrap-user-attributes
[m]
(m/map-vals (fn [maybe-coll]
(if (and (coll? maybe-coll)
(= 1 (count maybe-coll)))
(first maybe-coll)
maybe-coll))
m)) |
(defn- saml-response->attributes [saml-response]
(let [assertions (saml/assertions saml-response)
attrs (-> assertions first :attrs unwrap-user-attributes)]
(when-not attrs
(throw (ex-info (str (tru "Unable to log in: SAML info does not contain user attributes."))
{:status-code 401})))
attrs)) | |
(defn- base64-decode [^String s]
(when (u/base64-string? s)
(codecs/bytes->str
(.decode (Base64/getMimeDecoder) s)))) | |
(defmethod sso.i/sso-post :saml
;; Does the verification of the IDP's response and 'logs the user in'. The attributes are available in the response:
;; `(get-in saml-info [:assertions :attrs])
[{:keys [params], :as request}]
(premium-features/assert-has-feature :sso-saml (tru "SAML-based authentication"))
(check-saml-enabled)
(let [continue-url (u/ignore-exceptions
(when-let [s (some-> (:RelayState params) base64-decode)]
(when-not (str/blank? s)
s)))]
(sso-utils/check-sso-redirect continue-url)
(let [xml-string (str/trim (base64-decode (:SAMLResponse params)))
saml-response (xml-string->saml-response xml-string)
attrs (saml-response->attributes saml-response)
email (get attrs (sso-settings/saml-attribute-email))
first-name (get attrs (sso-settings/saml-attribute-firstname))
last-name (get attrs (sso-settings/saml-attribute-lastname))
groups (get attrs (sso-settings/saml-attribute-group))
session (fetch-or-create-user!
{:first-name first-name
:last-name last-name
:email email
:group-names groups
:user-attributes attrs
:device-info (request.u/device-info request)})
response (response/redirect (or continue-url (public-settings/site-url)))]
(mw.session/set-session-cookies request response session (t/zoned-date-time (t/zone-id "GMT")))))) | |
Namesapce for defining settings used by the SSO backends. This is separate as both the functions needed to support the SSO backends and the generic routing code used to determine which SSO backend to use need this information. Separating out this information creates a better dependency graph and avoids circular dependencies. | (ns metabase-enterprise.sso.integrations.sso-settings (:require [malli.core :as mc] [metabase.integrations.common :as integrations.common] [metabase.models.setting :as setting :refer [defsetting]] [metabase.models.setting.multi-setting :refer [define-multi-setting-impl]] [metabase.public-settings :as public-settings] [metabase.util.i18n :refer [deferred-tru trs tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [saml20-clj.core :as saml] [schema.core :as s])) |
(set! *warn-on-reflection* true) | |
(def ^:private GroupMappings [:maybe [:map-of ms/KeywordOrString [:sequential ms/PositiveInt]]]) | |
(def ^:private ^{:arglists '([group-mappings])} validate-group-mappings
(mc/validator GroupMappings)) | |
(defsetting saml-user-provisioning-enabled? (deferred-tru "When we enable SAML user provisioning, we automatically create a Metabase account on SAML signin for users who don''t have one.") :type :boolean :default true :feature :sso-saml :audit :getter) | |
(defsetting jwt-user-provisioning-enabled? (deferred-tru "When we enable JWT user provisioning, we automatically create a Metabase account on JWT signin for users who don''t have one.") :type :boolean :default true :feature :sso-jwt :audit :getter) | |
(defsetting ldap-user-provisioning-enabled? (deferred-tru "When we enable LDAP user provisioning, we automatically create a Metabase account on LDAP signin for users who don''t have one.") :type :boolean :default true :audit :getter) | |
(defsetting saml-identity-provider-uri (deferred-tru "This is the URL where your users go to log in to your identity provider. Depending on which IdP you''re using, this usually looks like https://your-org-name.example.com or https://example.com/app/my_saml_app/abc123/sso/saml") :feature :sso-saml :audit :getter) | |
Validate that an encoded identity provider certificate is valid, or throw an Exception. | (s/defn ^:private validate-saml-idp-cert
[idp-cert-str :- s/Str]
(try
(instance? java.security.cert.X509Certificate (saml/->X509Certificate idp-cert-str))
(catch Throwable e
(log/error e (trs "Error parsing SAML identity provider certificate"))
(throw
(Exception. (tru "Invalid identity provider certificate. Certificate should be a base-64 encoded string.")))))) |
(defsetting saml-identity-provider-certificate
(deferred-tru "Encoded certificate for the identity provider. Depending on your IdP, you might need to download this,
open it in a text editor, then copy and paste the certificate's contents here.")
:feature :sso-saml
:audit :no-value
:setter (fn [new-value]
;; when setting the idp cert validate that it's something we
(when new-value
(validate-saml-idp-cert new-value))
(setting/set-value-of-type! :string :saml-identity-provider-certificate new-value))) | |
(defsetting saml-identity-provider-issuer (deferred-tru "This is a unique identifier for the IdP. Often referred to as Entity ID or simply 'Issuer'. Depending on your IdP, this usually looks something like http://www.example.com/141xkex604w0Q5PN724v") :feature :sso-saml :audit :getter) | |
(defsetting saml-application-name (deferred-tru "This application name will be used for requests to the Identity Provider") :default "Metabase" :feature :sso-saml :audit :getter) | |
(defsetting saml-keystore-path (deferred-tru "Absolute path to the Keystore file to use for signing SAML requests") :feature :sso-saml :audit :getter) | |
(defsetting saml-keystore-password (deferred-tru "Password for opening the keystore") :default "changeit" :sensitive? true :feature :sso-saml :audit :getter) | |
(defsetting saml-keystore-alias
(deferred-tru "Alias for the key that {0} should use for signing SAML requests"
(public-settings/application-name-for-setting-descriptions))
:default "metabase"
:feature :sso-saml
:audit :getter) | |
(defsetting saml-attribute-email (deferred-tru "SAML attribute for the user''s email address") :default "http://schemas.xmlsoap.org/ws/2005/05/identity/claims/emailaddress" :feature :sso-saml :audit :getter) | |
(defsetting saml-attribute-firstname (deferred-tru "SAML attribute for the user''s first name") :default "http://schemas.xmlsoap.org/ws/2005/05/identity/claims/givenname" :feature :sso-saml :audit :getter) | |
(defsetting saml-attribute-lastname (deferred-tru "SAML attribute for the user''s last name") :default "http://schemas.xmlsoap.org/ws/2005/05/identity/claims/surname" :feature :sso-saml :audit :getter) | |
(defsetting saml-group-sync (deferred-tru "Enable group membership synchronization with SAML.") :type :boolean :default false :feature :sso-saml :audit :getter) | |
(defsetting saml-attribute-group (deferred-tru "SAML attribute for group syncing") :default "member_of" :feature :sso-saml :audit :getter) | |
(defsetting saml-group-mappings
;; Should be in the form: {"groupName": [1, 2, 3]} where keys are SAML groups and values are lists of MB groups IDs
(deferred-tru "JSON containing SAML to {0} group mappings."
(public-settings/application-name-for-setting-descriptions))
:type :json
:cache? false
:default {}
:feature :sso-saml
:audit :getter
:setter (comp (partial setting/set-value-of-type! :json :saml-group-mappings)
(partial mu/validate-throw validate-group-mappings))) | |
(defsetting saml-configured
(deferred-tru "Are the mandatory SAML settings configured?")
:type :boolean
:default false
:feature :sso-saml
:setter :none
:getter (fn [] (boolean
(and (saml-identity-provider-uri)
(saml-identity-provider-certificate))))) | |
(defsetting saml-enabled
(deferred-tru "Is SAML authentication configured and enabled?")
:type :boolean
:default false
:feature :sso-saml
:audit :getter
:getter (fn []
(if (saml-configured)
(setting/get-value-of-type :boolean :saml-enabled)
false))) | |
(defsetting jwt-identity-provider-uri (deferred-tru "URL of JWT based login page") :feature :sso-jwt :audit :getter) | |
(defsetting jwt-shared-secret
(deferred-tru (str "String used to seed the private key used to validate JWT messages."
" "
"A hexadecimal-encoded 256-bit key (i.e., a 64-character string) is strongly recommended."))
:type :string
:feature :sso-jwt
:audit :no-value) | |
(defsetting jwt-attribute-email (deferred-tru "Key to retrieve the JWT user's email address") :default "email" :feature :sso-jwt :audit :getter) | |
(defsetting jwt-attribute-firstname (deferred-tru "Key to retrieve the JWT user's first name") :default "first_name" :feature :sso-jwt :audit :getter) | |
(defsetting jwt-attribute-lastname (deferred-tru "Key to retrieve the JWT user's last name") :default "last_name" :feature :sso-jwt :audit :getter) | |
(defsetting jwt-attribute-groups (deferred-tru "Key to retrieve the JWT user's groups") :default "groups" :feature :sso-jwt :audit :getter) | |
(defsetting jwt-group-sync (deferred-tru "Enable group membership synchronization with JWT.") :type :boolean :default false :feature :sso-jwt :audit :getter) | |
(defsetting jwt-group-mappings
;; Should be in the form: {"groupName": [1, 2, 3]} where keys are JWT groups and values are lists of MB groups IDs
(deferred-tru "JSON containing JWT to {0} group mappings."
(public-settings/application-name-for-setting-descriptions))
:type :json
:cache? false
:default {}
:feature :sso-jwt
:audit :getter
:setter (comp (partial setting/set-value-of-type! :json :jwt-group-mappings)
(partial mu/validate-throw validate-group-mappings))) | |
(defsetting jwt-configured
(deferred-tru "Are the mandatory JWT settings configured?")
:type :boolean
:default false
:feature :sso-jwt
:setter :none
:getter (fn [] (boolean
(and (jwt-identity-provider-uri)
(jwt-shared-secret))))) | |
(defsetting jwt-enabled
(deferred-tru "Is JWT authentication configured and enabled?")
:type :boolean
:default false
:feature :sso-jwt
:audit :getter
:getter (fn []
(if (jwt-configured)
(setting/get-value-of-type :boolean :jwt-enabled)
false))) | |
(define-multi-setting-impl integrations.common/send-new-sso-user-admin-email? :ee :getter (fn [] (setting/get-value-of-type :boolean :send-new-sso-user-admin-email?)) :setter (fn [send-emails] (setting/set-value-of-type! :boolean :send-new-sso-user-admin-email? send-emails))) | |
Are we using an SSO integration other than LDAP or Google Auth? These integrations use the | (defsetting other-sso-enabled? :visibility :public :setter :none :getter (fn [] (or (saml-enabled) (jwt-enabled)))) |
Functions shared by the various SSO implementations | (ns metabase-enterprise.sso.integrations.sso-utils (:require [metabase-enterprise.sso.integrations.sso-settings :as sso-settings] [metabase.api.common :as api] [metabase.email.messages :as messages] [metabase.events :as events] [metabase.integrations.common :as integrations.common] [metabase.models.user :refer [User]] [metabase.public-settings :as public-settings] [metabase.util :as u] [metabase.util.i18n :refer [trs tru]] [metabase.util.log :as log] [metabase.util.malli :as mu] [metabase.util.malli.schema :as ms] [toucan2.core :as t2]) (:import (clojure.lang ExceptionInfo) (java.net URI))) |
(set! *warn-on-reflection* true) | |
(def ^:private UserAttributes
[:map {:closed true}
[:first_name [:maybe ms/NonBlankString]]
[:last_name [:maybe ms/NonBlankString]]
[:email ms/Email]
;; TODO - we should avoid hardcoding this to make it easier to add new integrations. Maybe look at something like
;; the keys of `(methods sso/sso-get)`
[:sso_source [:enum :saml :jwt]]
[:login_attributes [:maybe :map]]]) | |
(defn- maybe-throw-user-provisioning
[user-provisioning-type]
(when (not user-provisioning-type)
(throw (ex-info (trs "Sorry, but you''ll need a {0} account to view this page. Please contact your administrator."
(u/slugify (public-settings/site-name))) {})))) | |
If | (defmulti check-user-provisioning
{:arglists '([model])}
keyword) |
(defmethod check-user-provisioning :saml [_] (maybe-throw-user-provisioning (sso-settings/saml-user-provisioning-enabled?))) | |
(defmethod check-user-provisioning :ldap [_] (maybe-throw-user-provisioning (sso-settings/ldap-user-provisioning-enabled?))) | |
(defmethod check-user-provisioning :jwt [_] (maybe-throw-user-provisioning (sso-settings/jwt-user-provisioning-enabled?))) | |
This function is basically the same thing as the | (mu/defn create-new-sso-user!
[user :- UserAttributes]
(try
(u/prog1 (first (t2/insert-returning-instances! User (merge user {:password (str (random-uuid))})))
(log/info (trs "New SSO user created: {0} ({1})" (:common_name <>) (:email <>)))
;; publish user-invited event for audit logging
(events/publish-event! :event/user-invited {:object (assoc <> :sso_source (:sso_source user))})
;; send an email to everyone including the site admin if that's set
(when (integrations.common/send-new-sso-user-admin-email?)
(messages/send-user-joined-admin-notification-email! <>, :google-auth? true)))
(catch ExceptionInfo e
(log/error e "Error creating new SSO user")
(throw (ex-info (trs "Error creating new SSO user")
{:user user}))))) |
Update | (defn fetch-and-update-login-attributes!
[{:keys [email] :as user-from-sso}]
(when-let [{:keys [id] :as user} (t2/select-one User :%lower.email (u/lower-case-en email))]
(let [user-keys (keys user-from-sso)
;; remove keys with `nil` values
user-data (into {} (filter second user-from-sso))]
(if (= (select-keys user user-keys) user-data)
user
(do
(t2/update! User id user-data)
(t2/select-one User :id id)))))) |
Check if open redirect is being exploited in SSO. If so, or if the redirect-url is invalid, throw a 400. | (defn check-sso-redirect
[redirect-url]
(try
(let [host (some-> redirect-url (URI.) (.getHost))
our-host (some-> (public-settings/site-url) (URI.) (.getHost))]
(api/check-400 (or (nil? redirect-url) (nil? host) (= host our-host))))
(catch Exception e
(log/error e "Invalid redirect URL")
(throw (ex-info (tru "Invalid redirect URL")
{:status-code 400
:redirect-url redirect-url}))))) |
(ns metabase-enterprise.task.truncate-audit-tables (:require [metabase.public-settings.premium-features :refer [defenterprise]])) | |
List of models to truncate, as well as the name of the column containing the row's timestamp. EE version adds
| (defenterprise audit-models-to-truncate
:feature :audit-app
[]
[{:model :model/QueryExecution :timestamp-col :started_at}
{:model :model/AuditLog :timestamp-col :timestamp}
{:model :model/ViewLog :timestamp-col :timestamp}]) |